hosc-0.15/ 0000755 0000000 0000000 00000000000 12416134203 010555 5 ustar 00 0000000 0000000 hosc-0.15/hosc.cabal 0000644 0000000 0000000 00000006136 12416134203 012503 0 ustar 00 0000000 0000000 Name: hosc
Version: 0.15
Synopsis: Haskell Open Sound Control
Description: @hosc@ implements a subset of the /Open Sound Control/
byte protocol, .
.
"Sound.OSC.Core" implements the actual protocol.
.
"Sound.OSC.Transport.FD" implements a
/file descriptor/ based transport layer for @UDP@
and @TCP@.
.
"Sound.OSC.Transport.Monad" implements a
monadic interface to the @FD@ transport layer.
.
Composite modules are at "Sound.OSC" and "Sound.OSC.FD".
License: GPL
Category: Sound
Copyright: (c) Rohan Drape, Stefan Kersten and others, 2007-2014
Author: Rohan Drape, Stefan Kersten
Maintainer: rd@slavepianos.org
Stability: Experimental
Homepage: http://rd.slavepianos.org/t/hosc
Tested-With: GHC == 7.8.2
Build-Type: Simple
Cabal-Version: >= 1.8
Data-Files: README
Library
Build-Depends: base == 4.*,
binary >= 0.7.2,
blaze-builder >= 0.3,
bytestring,
data-binary-ieee754,
network >= 2.3,
time,
transformers
GHC-Options: -Wall -fwarn-tabs
Exposed-modules: Sound.OSC
Sound.OSC.Class
Sound.OSC.Coding
Sound.OSC.Coding.Byte
Sound.OSC.Coding.Cast
Sound.OSC.Coding.Decode.Base
Sound.OSC.Coding.Decode.Binary
Sound.OSC.Coding.Encode.Base
Sound.OSC.Coding.Encode.Builder
Sound.OSC.Core
Sound.OSC.Datum
Sound.OSC.FD
Sound.OSC.Normalise
Sound.OSC.Time
Sound.OSC.Transport.FD
Sound.OSC.Transport.FD.TCP
Sound.OSC.Transport.FD.UDP
Sound.OSC.Transport.Monad
Sound.OSC.Type
Sound.OSC.Wait
Source-Repository head
Type: darcs
Location: http://rd.slavepianos.org/sw/hosc/
Benchmark hosc-benchmark
Type: exitcode-stdio-1.0
Hs-Source-Dirs: benchmarks
Main-Is: benchmark.hs
Other-Modules:
Sound.OSC.NFData
Build-Depends:
base == 4.*
, hosc == 0.15.*
, bytestring
, criterion
, deepseq
GHC-Options: -Wall -fwarn-tabs -rtsopts -fno-warn-orphans
GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all
Test-Suite hosc-test
Type: exitcode-stdio-1.0
Hs-Source-Dirs: tests
Main-Is: test.hs
Other-Modules:
Sound.OSC.Arbitrary
Build-Depends:
base == 4.*
, bytestring >= 0.10
, hosc == 0.15.*
, QuickCheck >= 2
, test-framework >= 0.2
, test-framework-quickcheck2 >= 0.2
GHC-Options: -Wall -fwarn-tabs -rtsopts -fno-warn-orphans
GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all
hosc-0.15/Setup.hs 0000644 0000000 0000000 00000000110 12416134203 012201 0 ustar 00 0000000 0000000 #!/usr/bin/env runhaskell
import Distribution.Simple
main = defaultMain
hosc-0.15/README 0000644 0000000 0000000 00000001770 12416134203 011442 0 ustar 00 0000000 0000000 hosc - haskell open sound control
---------------------------------
[hosc][hosc] provides `Sound.OSC`, a [haskell][hs]
module implementing a subset of the [Open Sound Control][osc] byte protocol.
hosc is required by the [hsc3][hsc3] haskell [supercollider][sc3] bindings.
There are a number of related projects:
- [hosc-json](?t=hosc-json): JSON text encoding of OSC
- [hosc-utils](?t=hosc-utils): command line utilities
© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2014,
[gpl][gpl]. with contributions by:
- [alex mclean][am]
- [henning thielemann][ht]
see the [darcs][darcs] [history](?t=hosc&q=history) for details
[hosc]: http://rd.slavepianos.org/?t=hosc
[hs]: http://haskell.org/
[osc]: http://opensoundcontrol.org/
[hsc3]: http://rd.slavepianos.org/?t=hsc3
[sc3]: http://audiosynth.com/
[rd]: http://rd.slavepianos.org/
[sk]: http://space.k-hornz.de/
[am]: http://yaxu.org/
[ht]: http://www.henning-thielemann.de/Research.html
[darcs]: http://darcs.net/
[gpl]: http://gnu.org/copyleft/
hosc-0.15/Sound/ 0000755 0000000 0000000 00000000000 12416134203 011645 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC.hs 0000644 0000000 0000000 00000000452 12416134203 012626 0 ustar 00 0000000 0000000 -- | Composite of "Sound.OSC.Core" and "Sound.OSC.Transport.Monad".
module Sound.OSC (module M) where
import Control.Monad.IO.Class as M (MonadIO,liftIO)
import Sound.OSC.Core as M
import Sound.OSC.Transport.FD.UDP as M
import Sound.OSC.Transport.FD.TCP as M
import Sound.OSC.Transport.Monad as M
hosc-0.15/Sound/OSC/ 0000755 0000000 0000000 00000000000 12416134203 012271 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Normalise.hs 0000644 0000000 0000000 00000003676 12416134203 014572 0 ustar 00 0000000 0000000 -- | Datum normalisation.
module Sound.OSC.Normalise where
import Sound.OSC.Type as O
-- | Lift 'O.Int32' to 'O.Int64' and 'O.Float' to 'O.Double'.
--
-- > map normalise_datum [Int32 1,Float 1] == [Int64 1,Double 1]
normalise_datum :: Datum -> Datum
normalise_datum d =
case d of
Int32 n -> Int64 (fromIntegral n)
Float n -> Double (realToFrac n)
_ -> d
-- | A normalised 'O.Message' has only 'O.Int64' and 'O.Double'
-- numerical values.
--
-- > let m = message "/m" [Int32 0,Float 0]
-- > in normalise_message m == message "/m" [Int64 0,Double 0]
normalise_message :: Message -> Message
normalise_message = message_coerce normalise_datum
-- | A normalised 'O.Bundle' has only 'O.Int64' and 'O.Double'
-- numerical values.
normalise_bundle :: Bundle -> Bundle
normalise_bundle = bundle_coerce normalise_datum
-- * Coercion
-- | Map a normalising function over datum at an OSC 'Message'.
message_coerce :: (Datum -> Datum) -> Message -> Message
message_coerce f (Message s xs) = Message s (map f xs)
-- | Map a normalising function over datum at an OSC 'Bundle'.
bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle
bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)
-- * Promotion
-- | Coerce 'Int32', 'Int64' and 'Float' to 'Double'.
--
-- > map datum_promote [Int32 5,Float 5] == [Double 5,Double 5]
datum_promote :: Datum -> Datum
datum_promote d =
case d of
Int32 n -> Double (fromIntegral n)
Int64 n -> Double (fromIntegral n)
Float n -> Double (realToFrac n)
_ -> d
-- | 'O.Datum' as 'O.Int64' if 'O.Int32', 'O.Int64', 'O.Float' or
-- 'O.Double'.
--
-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5,string "5"]
-- > in map datum_floor d == [Int64 5,Int64 5,Int64 5,Int64 5,string "5"]
datum_floor :: Datum -> Datum
datum_floor d =
case d of
Int32 x -> Int64 (fromIntegral x)
Float x -> Int64 (fromInteger (floor x))
Double x -> Int64 (fromInteger (floor x))
_ -> d
hosc-0.15/Sound/OSC/Datum.hs 0000644 0000000 0000000 00000003527 12416134203 013706 0 ustar 00 0000000 0000000 -- | 'Datum' related functions.
module Sound.OSC.Datum where
import qualified Data.ByteString.Lazy as B {- bytestring -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import Data.Int {- base -}
import Data.Word {- base -}
import Sound.OSC.Type
-- | Type specialised 'd_get'.
--
-- > map datum_int32 [Int32 1,Float 1] == [Just 1,Nothing]
datum_int32 :: Datum -> Maybe Int32
datum_int32 = d_get
-- | Type specialised 'd_get'.
datum_int64 :: Datum -> Maybe Int64
datum_int64 = d_get
-- | Type specialised 'd_get'.
datum_float :: Datum -> Maybe Float
datum_float = d_get
-- | Type specialised 'd_get'.
datum_double :: Datum -> Maybe Double
datum_double = d_get
-- | Type specialised 'd_get'.
--
-- > datum_ascii (d_put (C.pack "string")) == Just (C.pack "string")
datum_ascii :: Datum -> Maybe ASCII
datum_ascii = d_get
-- | 'C.unpack' of 'd_get'.
--
-- > datum_string (d_put (C.pack "string")) == Just "string"
-- > map datum_string [string "string",Int32 5] == [Just "string",Nothing]
datum_string :: Datum -> Maybe String
datum_string = fmap C.unpack . datum_ascii
-- | Type specialised 'd_get'.
datum_blob :: Datum -> Maybe B.ByteString
datum_blob = d_get
-- | 'Maybe' variant of 'd_timestamp'.
datum_timestamp :: Datum -> Maybe Time
datum_timestamp d = case d of {TimeStamp x -> Just x;_ -> Nothing}
-- | Type specialised 'd_get'.
datum_midi :: Datum -> Maybe MIDI
datum_midi = d_get
-- | 'Datum' as sequence of 'Word8' if 'ASCII_String', 'Blob' or 'Midi'.
--
-- > let d = [string "5",Blob (B.pack [53]),midi (0x00,0x90,0x40,0x60)]
-- > in Data.Maybe.mapMaybe datum_sequence d == [[53],[53],[0,144,64,96]]
datum_sequence :: Datum -> Maybe [Word8]
datum_sequence d =
case d of
ASCII_String s -> Just (map (fromIntegral . fromEnum) (C.unpack s))
Blob s -> Just (B.unpack s)
Midi (MIDI p q r s) -> Just [p,q,r,s]
_ -> Nothing
hosc-0.15/Sound/OSC/Wait.hs 0000644 0000000 0000000 00000001330 12416134203 013526 0 ustar 00 0000000 0000000 -- | Waiting (for replies).
module Sound.OSC.Wait where
import System.Timeout {- base -}
-- * Timeout
-- | Real valued variant of 'timeout'.
timeout_r :: Double -> IO a -> IO (Maybe a)
timeout_r t = timeout (floor (t * 1000000))
-- * Wait
-- | Repeat action until predicate /f/ is 'True' when applied to
-- result.
untilPredicate :: Monad m => (a -> Bool) -> m a -> m a
untilPredicate f act =
let g p = if f p then rec else return p
rec = act >>= g
in rec
-- | Repeat action until /f/ does not give 'Nothing' when applied to
-- result.
untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b
untilMaybe f act =
let g p = case f p of {Nothing -> rec;Just r -> return r}
rec = act >>= g
in rec
hosc-0.15/Sound/OSC/Core.hs 0000644 0000000 0000000 00000001273 12416134203 013520 0 ustar 00 0000000 0000000 -- | Composite of non-transport related modules.
--
-- Provides the 'Datum', 'Message', 'Bundle' and 'Packet' types and
-- the 'Datem', 'OSC' and 'Coding' type-classes.
--
-- The basic constructors are 'message' and 'bundle', the basic coding
-- functions are 'encodePacket' and 'decodePacket'.
--
-- > import Sound.OSC.Core
-- >
-- > let {o = bundle immediately [message "/g_free" [Int32 0]]
-- > ;e = encodeBundle o :: String}
-- > in decodeBundle e == o
module Sound.OSC.Core (module M) where
import Sound.OSC.Class as M
import Sound.OSC.Coding as M
import Sound.OSC.Datum as M
import Sound.OSC.Normalise as M
import Sound.OSC.Time as M
import Sound.OSC.Type as M
import Sound.OSC.Wait as M
hosc-0.15/Sound/OSC/Coding.hs 0000644 0000000 0000000 00000003307 12416134203 014033 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleInstances,TypeSynonymInstances #-}
-- | A type-class to provide coding operations to different data types
-- using the same function names.
module Sound.OSC.Coding where
import qualified Data.ByteString as S {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}
import Sound.OSC.Type
import qualified Sound.OSC.Coding.Decode.Binary as Binary
import qualified Sound.OSC.Coding.Encode.Builder as Builder
-- | Converting from and to binary packet representations.
class Coding a where
encodePacket :: Packet -> a -- ^ Decode an OSC packet.
decodePacket :: a -> Packet -- ^ Encode an OSC packet.
instance Coding S.ByteString where
encodePacket = Builder.encodePacket_strict
decodePacket = Binary.decodePacket_strict
instance Coding B.ByteString where
encodePacket = Builder.encodePacket
decodePacket = Binary.decodePacket
instance Coding String where
encodePacket = C.unpack . encodePacket
decodePacket = decodePacket . C.pack
-- | An 'encodePacket' and 'decodePacket' pair over 'B.ByteString'.
type Coder = (Packet -> B.ByteString,B.ByteString -> Packet)
-- | 'encodePacket' '.' 'Packet_Message'.
encodeMessage :: Coding c => Message -> c
encodeMessage = encodePacket . Packet_Message
-- | 'encodePacket' '.' 'Packet_Bundle'.
encodeBundle :: Coding c => Bundle -> c
encodeBundle = encodePacket . Packet_Bundle
-- | 'packet_to_message' '.' 'decodePacket'.
decodeMessage :: Coding c => c -> Maybe Message
decodeMessage = packet_to_message . decodePacket
-- | 'packet_to_bundle' '.' 'decodePacket'.
decodeBundle :: Coding c => c -> Bundle
decodeBundle = packet_to_bundle . decodePacket
hosc-0.15/Sound/OSC/Type.hs 0000644 0000000 0000000 00000027563 12416134203 013563 0 ustar 00 0000000 0000000 -- | Alegbraic data types for OSC datum and packets.
module Sound.OSC.Type where
import qualified Data.ByteString.Lazy as B {- bytestring -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import Data.Int {- base -}
import Data.List {- base -}
import Data.Word {- base -}
import Numeric {- base -}
-- * Time
-- | @NTP@ time in real-valued (fractional) form.
type Time = Double
-- | Constant indicating a bundle to be executed immediately.
immediately :: Time
immediately = 1 / 2^(32::Int)
-- * Datum
-- | Type enumerating Datum categories.
type Datum_Type = Char
-- | Type for ASCII strings (strict 'Char'8 'C.ByteString').
type ASCII = C.ByteString
-- | Type-specialised 'C.pack'.
ascii :: String -> ASCII
ascii = C.pack
-- | Type-specialised 'C.unpack'.
ascii_to_string :: ASCII -> String
ascii_to_string = C.unpack
-- | Four-byte midi message.
data MIDI = MIDI Word8 Word8 Word8 Word8
deriving (Eq,Show,Read)
-- | The basic elements of OSC messages.
data Datum = Int32 {d_int32 :: Int32}
| Int64 {d_int64 :: Int64}
| Float {d_float :: Float}
| Double {d_double :: Double}
| ASCII_String {d_ascii_string :: ASCII}
| Blob {d_blob :: B.ByteString}
| TimeStamp {d_timestamp :: Time}
| Midi {d_midi :: MIDI}
deriving (Eq,Read,Show)
-- | Single character identifier of an OSC datum.
datum_tag :: Datum -> Datum_Type
datum_tag dt =
case dt of
Int32 _ -> 'i'
Int64 _ -> 'h'
Float _ -> 'f'
Double _ -> 'd'
ASCII_String _ -> 's'
Blob _ -> 'b'
TimeStamp _ -> 't'
Midi _ -> 'm'
-- | 'Datum' as 'Integral' if 'Sound.OSC.Type.Int32' or
-- 'Sound.OSC.Type.Int64'.
--
-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]
-- > in map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]
datum_integral :: Integral i => Datum -> Maybe i
datum_integral d =
case d of
Int32 x -> Just (fromIntegral x)
Int64 x -> Just (fromIntegral x)
_ -> Nothing
-- | 'Datum' as 'Floating' if 'Sound.OSC.Type.Int32',
-- 'Sound.OSC.Type.Int64', 'Sound.OSC.Type.Float',
-- 'Sound.OSC.Type.Double' or 'TimeStamp'.
--
-- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]
-- > in Data.Maybe.mapMaybe datum_floating d == replicate 5 (5::Double)
datum_floating :: Floating n => Datum -> Maybe n
datum_floating d =
case d of
Int32 n -> Just (fromIntegral n)
Int64 n -> Just (fromIntegral n)
Float n -> Just (realToFrac n)
Double n -> Just (realToFrac n)
TimeStamp n -> Just (realToFrac n)
_ -> Nothing
-- | Class for translating to and from 'Datum'. There are instances
-- for the direct 'Datum' field types.
--
-- > d_put (1::Int32) == Int32 1
-- > d_put (1::Int64) == Int64 1
-- > d_put (1::Float) == Float 1
-- > d_put (1::Double) == Double 1
-- > d_put (C.pack "str") == ASCII_String (C.pack "str")
-- > d_put (B.pack [37,37]) == Blob (B.pack [37,37])
-- > d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)
--
-- There are also instances for standard Haskell types.
--
-- > d_put (1::Int) == Int64 1
-- > d_put (1::Integer) == Int64 1
class Datem a where
d_put :: a -> Datum
d_get :: Datum -> Maybe a
instance Datem Int32 where
d_put = Int32
d_get d = case d of {Int32 x -> Just x;_ -> Nothing}
instance Datem Int64 where
d_put = Int64
d_get d = case d of {Int64 x -> Just x;_ -> Nothing}
instance Datem Int where
d_put = Int64 . fromIntegral
d_get = datum_integral
instance Datem Integer where
d_put = Int64 . fromIntegral
d_get = datum_integral
instance Datem Float where
d_put = Float
d_get d = case d of {Float x -> Just x;_ -> Nothing}
instance Datem Double where
d_put = Double
d_get d = case d of {Double x -> Just x;_ -> Nothing}
instance Datem C.ByteString where
d_put = ASCII_String
d_get d = case d of {ASCII_String x -> Just x;_ -> Nothing}
instance Datem B.ByteString where
d_put = Blob
d_get d = case d of {Blob x -> Just x;_ -> Nothing}
instance Datem MIDI where
d_put = Midi
d_get d = case d of {Midi x -> Just x;_ -> Nothing}
-- | Type generalised 'Sound.OSC.Type.Int32'.
--
-- > int32 (1::Int32) == int32 (1::Integer)
-- > d_int32 (int32 (maxBound::Int32)) == maxBound
-- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
int32 :: Integral n => n -> Datum
int32 = Int32 . fromIntegral
-- | Type generalised 'Sound.OSC.Type.Int64'.
--
-- > int64 (1::Int32) == int64 (1::Integer)
-- > d_int64 (int64 (maxBound::Int64)) == maxBound
int64 :: Integral n => n -> Datum
int64 = Int64 . fromIntegral
-- | Type generalised 'Sound.OSC.Type.Float'.
--
-- > float (1::Int) == float (1::Double)
-- > floatRange (undefined::Float) == (-125,128)
-- > isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True
float :: Real n => n -> Datum
float = Float . realToFrac
-- | Type generalised 'Sound.OSC.Type.Double'.
--
-- > double (1::Int) == double (1::Double)
-- > double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
double :: Real n => n -> Datum
double = Double . realToFrac
-- | 'ASCII_String' of 'C.pack'.
--
-- > string "string" == ASCII_String (C.pack "string")
string :: String -> Datum
string = ASCII_String . C.pack
-- | Four-tuple variant of 'Midi' '.' 'MIDI'.
--
-- > midi (0,0,0,0) == Midi (MIDI 0 0 0 0)
midi :: (Word8,Word8,Word8,Word8) -> Datum
midi (p,q,r,s) = Midi (MIDI p q r s)
-- * Message
-- | OSC address pattern. This is strictly an ASCII value, but it is
-- very common to pattern match on addresses and matching on
-- 'C.ByteString' requires @OverloadedStrings@.
type Address_Pattern = String
-- | An OSC message.
data Message = Message {messageAddress :: Address_Pattern
,messageDatum :: [Datum]}
deriving (Eq,Read,Show)
-- | 'Message' constructor. It is an 'error' if the 'Address_Pattern'
-- doesn't conform to the OSC specification.
message :: Address_Pattern -> [Datum] -> Message
message a xs =
case a of
'/':_ -> Message a xs
_ -> error "message: ill-formed address pattern"
-- | Message argument types are given by a descriptor.
--
-- > C.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",ifs"
descriptor :: [Datum] -> ASCII
descriptor l = C.pack (',' : map datum_tag l)
-- | Descriptor tags are @comma@ prefixed.
descriptor_tags :: ASCII -> ASCII
descriptor_tags = C.drop 1
-- * Bundle
-- | An OSC bundle.
data Bundle = Bundle {bundleTime :: Time
,bundleMessages :: [Message]}
deriving (Eq,Read,Show)
-- | OSC 'Bundle's can be ordered (time ascending).
instance Ord Bundle where
compare (Bundle a _) (Bundle b _) = compare a b
-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is
-- empty.
bundle :: Time -> [Message] -> Bundle
bundle t xs =
case xs of
[] -> error "bundle: empty?"
_ -> Bundle t xs
-- * Packet
-- | An OSC 'Packet' is either a 'Message' or a 'Bundle'.
data Packet = Packet_Message {packetMessage :: Message}
| Packet_Bundle {packetBundle :: Bundle}
deriving (Eq,Read,Show)
-- | 'Packet_Bundle' '.' 'bundle'.
p_bundle :: Time -> [Message] -> Packet
p_bundle t = Packet_Bundle . bundle t
-- | 'Packet_Message' '.' 'message'.
p_message :: Address_Pattern -> [Datum] -> Packet
p_message a = Packet_Message . message a
-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is
-- 'immediately'.
packetTime :: Packet -> Time
packetTime = at_packet (const immediately) bundleTime
-- | Retrieve the set of 'Message's from a 'Packet'.
packetMessages :: Packet -> [Message]
packetMessages = at_packet return bundleMessages
-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.
packet_to_bundle :: Packet -> Bundle
packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id
-- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time
-- tag and with one element, return the 'Message', else 'Nothing'.
packet_to_message :: Packet -> Maybe Message
packet_to_message p =
case p of
Packet_Bundle b ->
case b of
Bundle t [m] -> if t == immediately then Just m else Nothing
_ -> Nothing
Packet_Message m -> Just m
-- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp
-- 'immediately', or a plain Message.
packet_is_immediate :: Packet -> Bool
packet_is_immediate = (== immediately) . packetTime
-- | Variant of 'either' for 'Packet'.
at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet f g p =
case p of
Packet_Message m -> f m
Packet_Bundle b -> g b
-- * Address Query
-- | Does 'Message' have the specified 'Address_Pattern'.
message_has_address :: Address_Pattern -> Message -> Bool
message_has_address x = (== x) . messageAddress
-- | Do any of the 'Message's at 'Bundle' have the specified
-- 'Address_Pattern'.
bundle_has_address :: Address_Pattern -> Bundle -> Bool
bundle_has_address x = any (message_has_address x) . bundleMessages
-- | Does 'Packet' have the specified 'Address_Pattern', ie.
-- 'message_has_address' or 'bundle_has_address'.
packet_has_address :: Address_Pattern -> Packet -> Bool
packet_has_address x =
at_packet (message_has_address x)
(bundle_has_address x)
-- * Pretty printing
-- | Perhaps a precision value for floating point numbers.
type FP_Precision = Maybe Int
-- | Variant of 'showFFloat' that deletes trailing zeros.
--
-- > map (floatPP (Just 4)) [1,pi] == ["1.0","3.1416"]
floatPP :: RealFloat n => Maybe Int -> n -> String
floatPP p n =
let s = showFFloat p n ""
s' = dropWhile (== '0') (reverse s)
in case s' of
'.':_ -> reverse ('0' : s')
_ -> reverse s'
-- | Pretty printer for 'Time'.
--
-- > timePP (Just 4) (1/3) == "0.3333"
timePP :: FP_Precision -> Time -> String
timePP = floatPP
-- | Pretty printer for vectors.
--
-- > vecPP [1::Int,2,3] == "<1,2,3>"
vecPP :: Show a => [a] -> String
vecPP v = '<' : intercalate "," (map show v) ++ ">"
-- | Pretty printer for 'Datum'.
--
-- > let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60)]
-- > in map datumPP d == ["1","1.2","\"str\"","<0,144,64,96>"]
datumPP :: FP_Precision -> Datum -> String
datumPP p d =
case d of
Int32 n -> show n
Int64 n -> show n
Float n -> floatPP p n
Double n -> floatPP p n
ASCII_String s -> show (C.unpack s)
Blob s -> show s
TimeStamp t -> timePP p t
Midi (MIDI b1 b2 b3 b4) -> vecPP [b1,b2,b3,b4]
-- | Pretty printer for 'Message'.
messagePP :: FP_Precision -> Message -> String
messagePP p (Message a d) =
let d' = map (datumPP p) d
in unwords ("#message" : a : d')
-- | Pretty printer for 'Bundle'.
bundlePP :: FP_Precision -> Bundle -> String
bundlePP p (Bundle t m) =
let m' = intersperse ";" (map (messagePP p) m)
in unwords ("#bundle" : timePP p t : m')
-- | Pretty printer for 'Packet'.
packetPP :: FP_Precision -> Packet -> String
packetPP p pkt =
case pkt of
Packet_Message m -> messagePP p m
Packet_Bundle b -> bundlePP p b
-- * Parser
-- | Variant of 'read'.
readMaybe :: (Read a) => String -> Maybe a
readMaybe s =
case reads s of
[(x, "")] -> Just x
_ -> Nothing
-- | 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 (B.pack [112,105]))
-- > parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))
parse_datum :: Datum_Type -> String -> Maybe Datum
parse_datum ty =
case ty of
'i' -> fmap Int32 . readMaybe
'h' -> fmap Int64 . readMaybe
'f' -> fmap Float . readMaybe
'd' -> fmap Double . readMaybe
's' -> fmap (ASCII_String . C.pack) . readMaybe
'b' -> fmap (Blob . B.pack) . readMaybe
't' -> error "parse_datum: timestamp"
'm' -> fmap midi . readMaybe
_ -> error "parse_datum: type"
hosc-0.15/Sound/OSC/Class.hs 0000644 0000000 0000000 00000001522 12416134203 013672 0 ustar 00 0000000 0000000 -- | Typeclass for encoding and decoding OSC packets.
module Sound.OSC.Class where
import Sound.OSC.Type
import Sound.OSC.Coding
-- | A type-class for values that can be translated to and from OSC
-- 'Packet's.
class OSC o where
toPacket :: o -> Packet -- ^ Translation to 'Packet'.
fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.
instance OSC Message where
toPacket = Packet_Message
fromPacket = packet_to_message
instance OSC Bundle where
toPacket = Packet_Bundle
fromPacket = Just . packet_to_bundle
instance OSC Packet where
toPacket = id
fromPacket = Just
-- | 'encodePacket' '.' 'toPacket'.
encodeOSC :: (Coding c,OSC o) => o -> c
encodeOSC = encodePacket . toPacket
-- | 'fromPacket' '.' 'decodePacket'.
decodeOSC :: (Coding c,OSC o) => c -> Maybe o
decodeOSC = fromPacket . decodePacket
hosc-0.15/Sound/OSC/FD.hs 0000644 0000000 0000000 00000000363 12416134203 013120 0 ustar 00 0000000 0000000 -- | Composite of "Sound.OSC.Core" and "Sound.OSC.Transport.FD".
module Sound.OSC.FD (module M) where
import Sound.OSC.Core as M
import Sound.OSC.Transport.FD as M
import Sound.OSC.Transport.FD.UDP as M
import Sound.OSC.Transport.FD.TCP as M
hosc-0.15/Sound/OSC/Time.hs 0000644 0000000 0000000 00000006723 12416134203 013533 0 ustar 00 0000000 0000000 -- | OSC related timing functions. OSC timestamps are @NTP@ values,
-- .
module Sound.OSC.Time where
import Control.Concurrent {- base -}
import Control.Monad {- base -}
import Control.Monad.IO.Class {- transformers -}
import Data.Word {- base -}
import qualified Data.Time as T {- time -}
import qualified Data.Time.Clock.POSIX as T {- time -}
import Sound.OSC.Type
-- * Temporal types
-- | Type for integer (binary) representation of @NTP@ time.
type NTPi = Word64
-- | @Unix/Posix@ epoch time in real-valued (fractional) form.
type UT = Double
-- * Time conversion
-- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.
ntpr_to_ntpi :: RealFrac n => n -> NTPi
ntpr_to_ntpi t = round (t * 2^(32::Int))
-- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.
ntpi_to_ntpr :: Fractional n => NTPi -> n
ntpi_to_ntpr t = fromIntegral t / 2^(32::Int)
-- | Difference (in seconds) between /NTP/ and /UT/ epochs.
--
-- > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567
ntp_ut_epoch_diff :: Num n => n
ntp_ut_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60
-- | Convert a 'UT' timestamp to an 'NTPi' timestamp.
ut_to_ntpi :: UT -> NTPi
ut_to_ntpi t = ntpr_to_ntpi (t + ntp_ut_epoch_diff)
-- | Convert @Unix/Posix@ to @NTP@.
ut_to_ntpr :: Num n => n -> n
ut_to_ntpr = (+) ntp_ut_epoch_diff
-- | Convert @NTP@ to @Unix/Posix@.
ntpr_to_ut :: Num n => n -> n
ntpr_to_ut = (+) (negate ntp_ut_epoch_diff)
-- | Convert 'NTPi' to @Unix/Posix@.
ntpi_to_ut :: NTPi -> UT
ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr
-- * 'Data.Time' inter-operation.
-- | The time at 1970-01-01:00:00:00.
ut_epoch :: T.UTCTime
ut_epoch =
let d = T.fromGregorian 1970 1 1
s = T.secondsToDiffTime 0
in T.UTCTime d s
-- | Convert 'T.UTCTime' to @Unix/Posix@.
utc_to_ut :: Fractional n => T.UTCTime -> n
utc_to_ut t = realToFrac (T.diffUTCTime t ut_epoch)
-- * Clock operations
-- | Read current real-valued @NTP@ timestamp.
--
-- > do {ct <- fmap utc_to_ut T.getCurrentTime
-- > ;pt <- fmap realToFrac T.getPOSIXTime
-- > ;print (pt - ct,pt - ct < 1e-5)}
time :: MonadIO m => m Time
time = liftIO (fmap (ut_to_ntpr . realToFrac) T.getPOSIXTime)
-- * Thread operations.
-- | 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@.
pauseThreadLimit :: Fractional n => n
pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6
-- | Pause current thread for the indicated duration (in seconds), see
-- 'pauseThreadLimit'.
pauseThread :: (MonadIO m,Ord n,RealFrac n) => n -> m ()
pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6))))
-- | Type restricted 'pauseThread'.
wait :: MonadIO m => Double -> m ()
wait = pauseThread
-- | Pause current thread until the given 'Time', see
-- 'pauseThreadLimit'.
pauseThreadUntil :: MonadIO m => Time -> m ()
pauseThreadUntil t = pauseThread . (t -) =<< time
-- | Sleep current thread for the indicated duration (in seconds).
-- Divides long sleeps into parts smaller than 'pauseThreadLimit'.
sleepThread :: (RealFrac n, MonadIO m) => n -> m ()
sleepThread n =
if n >= pauseThreadLimit
then let n' = pauseThreadLimit - 1
in pauseThread n >> sleepThread (n - n')
else pauseThread n
-- | Sleep current thread until the given 'Time'. Divides long sleeps
-- into parts smaller than 'pauseThreadLimit'.
sleepThreadUntil :: MonadIO m => Time -> m ()
sleepThreadUntil t = sleepThread . (t -) =<< time
hosc-0.15/Sound/OSC/Transport/ 0000755 0000000 0000000 00000000000 12416134203 014265 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Transport/Monad.hs 0000644 0000000 0000000 00000007307 12416134203 015666 0 ustar 00 0000000 0000000 -- | Monad class implementing an Open Sound Control transport.
module Sound.OSC.Transport.Monad where
import Control.Monad (liftM) {- base -}
import Control.Monad.Trans.Reader {- transformers -}
import Control.Monad.IO.Class as M {- transformers -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Sound.OSC.Class
import qualified Sound.OSC.Transport.FD as T
import Sound.OSC.Type
import Sound.OSC.Wait
-- | Sender monad.
class Monad m => SendOSC m where
-- | Encode and send an OSC packet.
sendOSC :: OSC o => o -> m ()
-- | Receiver monad.
class Monad m => RecvOSC m where
-- | Receive and decode an OSC packet.
recvPacket :: m Packet
-- | 'DuplexOSC' is the union of 'SendOSC' and 'RecvOSC'.
class (SendOSC m,RecvOSC m) => DuplexOSC m where
-- | 'Transport' is 'DuplexOSC' with a 'MonadIO' constraint.
class (DuplexOSC m,MonadIO m) => Transport m where
instance (T.Transport t,MonadIO io) => SendOSC (ReaderT t io) where
sendOSC o = ReaderT (M.liftIO . flip T.sendOSC o)
instance (T.Transport t,MonadIO io) => RecvOSC (ReaderT t io) where
recvPacket = ReaderT (M.liftIO . T.recvPacket)
instance (T.Transport t,MonadIO io) => DuplexOSC (ReaderT t io) where
instance (T.Transport t,MonadIO io) => Transport (ReaderT t io) where
-- | Transport connection.
type Connection t a = ReaderT t IO a
-- | Bracket Open Sound Control communication.
withTransport :: T.Transport t => IO t -> Connection t a -> IO a
withTransport u = T.withTransport u . runReaderT
-- * Send
-- | Type restricted synonym for 'sendOSC'.
sendMessage :: SendOSC m => Message -> m ()
sendMessage = sendOSC
-- | Type restricted synonym for 'sendOSC'.
sendBundle :: SendOSC m => Bundle -> m ()
sendBundle = sendOSC
-- * Receive
-- | Variant of 'recvPacket' that runs 'fromPacket'.
recvOSC :: (RecvOSC m,OSC o) => m (Maybe o)
recvOSC = liftM fromPacket recvPacket
-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.
recvBundle :: (RecvOSC m) => m Bundle
recvBundle = liftM packet_to_bundle recvPacket
-- | Variant of 'recvPacket' that runs 'packet_to_message'.
recvMessage :: (RecvOSC m) => m (Maybe Message)
recvMessage = liftM packet_to_message recvPacket
-- | Variant of 'recvPacket' that runs 'packetMessages'.
recvMessages :: (RecvOSC m) => m [Message]
recvMessages = liftM packetMessages recvPacket
-- * Wait
-- | Wait for a 'Packet' where the supplied predicate is 'True',
-- discarding intervening packets.
waitUntil :: (RecvOSC m) => (Packet -> Bool) -> m Packet
waitUntil f = untilPredicate f recvPacket
-- | Wait for a 'Packet' where the supplied function does not give
-- 'Nothing', discarding intervening packets.
waitFor :: (RecvOSC m) => (Packet -> Maybe a) -> m a
waitFor f = untilMaybe f recvPacket
-- | 'waitUntil' 'packet_is_immediate'.
waitImmediate :: RecvOSC m => m Packet
waitImmediate = waitUntil packet_is_immediate
-- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or
-- immediate mode 'Bundle' with one element.
waitMessage :: RecvOSC m => m Message
waitMessage = waitFor packet_to_message
-- | A 'waitFor' for variant using 'packet_has_address' to match on
-- the 'Address_Pattern' of incoming 'Packets'.
waitAddress :: RecvOSC m => Address_Pattern -> m Packet
waitAddress s =
let f o = if packet_has_address s o then Just o else Nothing
in waitFor f
-- | Variant on 'waitAddress' that returns matching 'Message'.
waitReply :: RecvOSC m => Address_Pattern -> m Message
waitReply s =
let f = fromMaybe (error "waitReply: message not located?") .
find (message_has_address s) .
packetMessages
in liftM f (waitAddress s)
-- | Variant of 'waitReply' that runs 'messageDatum'.
waitDatum :: RecvOSC m => Address_Pattern -> m [Datum]
waitDatum = liftM messageDatum . waitReply
hosc-0.15/Sound/OSC/Transport/FD.hs 0000644 0000000 0000000 00000006410 12416134203 015113 0 ustar 00 0000000 0000000 -- | An abstract transport layer with implementations for @UDP@ and
-- @TCP@ transport.
module Sound.OSC.Transport.FD where
import Control.Exception {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Sound.OSC.Class
import Sound.OSC.Type
import Sound.OSC.Wait
-- | Abstract over the underlying transport protocol.
class Transport t where
-- | Encode and send an OSC packet.
sendOSC :: OSC o => t -> o -> IO ()
-- | Receive and decode an OSC packet.
recvPacket :: t -> IO Packet
-- | Close an existing connection.
close :: t -> IO ()
-- | Bracket OSC communication.
withTransport :: Transport t => IO t -> (t -> IO a) -> IO a
withTransport u = bracket u close
-- * Send
-- | Type restricted synonym for 'sendOSC'.
sendMessage :: Transport t => t -> Message -> IO ()
sendMessage = sendOSC
-- | Type restricted synonym for 'sendOSC'.
sendBundle :: Transport t => t -> Bundle -> IO ()
sendBundle = sendOSC
-- * Receive
-- | Variant of 'recvPacket' that runs 'fromPacket'.
recvOSC :: (Transport t,OSC o) => t -> IO (Maybe o)
recvOSC = fmap fromPacket . recvPacket
-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.
recvBundle :: (Transport t) => t -> IO Bundle
recvBundle = fmap packet_to_bundle . recvPacket
-- | Variant of 'recvPacket' that runs 'packet_to_message'.
recvMessage :: (Transport t) => t -> IO (Maybe Message)
recvMessage = fmap packet_to_message . recvPacket
-- | Variant of 'recvPacket' that runs 'packetMessages'.
recvMessages :: (Transport t) => t -> IO [Message]
recvMessages = fmap packetMessages . recvPacket
-- * Timeout
-- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.
recvPacketTimeout :: (Transport t) => Double -> t -> IO (Maybe Packet)
recvPacketTimeout n fd = timeout_r n (recvPacket fd)
-- * Wait
-- | Wait for a 'Packet' where the supplied predicate is 'True',
-- discarding intervening packets.
waitUntil :: (Transport t) => t -> (Packet -> Bool) -> IO Packet
waitUntil t f = untilPredicate f (recvPacket t)
-- | Wait for a 'Packet' where the supplied function does not give
-- 'Nothing', discarding intervening packets.
waitFor :: (Transport t) => t -> (Packet -> Maybe a) -> IO a
waitFor t f = untilMaybe f (recvPacket t)
-- | 'waitUntil' 'packet_is_immediate'.
waitImmediate :: Transport t => t -> IO Packet
waitImmediate t = waitUntil t packet_is_immediate
-- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or
-- immediate mode 'Bundle' with one element.
waitMessage :: Transport t => t -> IO Message
waitMessage t = waitFor t packet_to_message
-- | A 'waitFor' for variant using 'packet_has_address' to match on
-- the 'Address_Pattern' of incoming 'Packets'.
waitAddress :: Transport t => t -> Address_Pattern -> IO Packet
waitAddress t s =
let f o = if packet_has_address s o then Just o else Nothing
in waitFor t f
-- | Variant on 'waitAddress' that returns matching 'Message'.
waitReply :: Transport t => t -> Address_Pattern -> IO Message
waitReply t s =
let f = fromMaybe (error "waitReply: message not located?") .
find (message_has_address s) .
packetMessages
in fmap f (waitAddress t s)
-- | Variant of 'waitReply' that runs 'messageDatum'.
waitDatum :: Transport t => t -> Address_Pattern -> IO [Datum]
waitDatum t = fmap messageDatum . waitReply t
hosc-0.15/Sound/OSC/Transport/FD/ 0000755 0000000 0000000 00000000000 12416134203 014556 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Transport/FD/UDP.hs 0000644 0000000 0000000 00000004055 12416134203 015546 0 ustar 00 0000000 0000000 -- | OSC over UDP implementation.
module Sound.OSC.Transport.FD.UDP where
import Control.Monad {- base -}
import qualified Network.Socket as N {- network -}
import qualified Network.Socket.ByteString as C {- network -}
import Sound.OSC.Class
import Sound.OSC.Coding
import Sound.OSC.Type
import Sound.OSC.Transport.FD
-- | The UDP transport handle data type.
data UDP = UDP {udpSocket :: N.Socket}
-- | Return the port number associated with the UDP socket.
udpPort :: Integral n => UDP -> IO n
udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)
instance Transport UDP where
-- C.L.send is not implemented for W32
sendOSC (UDP fd) msg = void (C.send fd (encodeOSC msg))
recvPacket (UDP fd) = liftM decodePacket (C.recv fd 8192)
close (UDP fd) = N.sClose fd
-- | Create and initialise UDP socket.
udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO UDP
udp_socket f host port = do
fd <- N.socket N.AF_INET N.Datagram 0
a <- N.inet_addr host
let sa = N.SockAddrInet (fromIntegral port) a
f fd sa
return (UDP fd)
-- | Make a 'UDP' connection.
--
-- > let t = openUDP "127.0.0.1" 57110
-- > in withTransport t (\fd -> recvT 0.5 fd >>= print)
openUDP :: String -> Int -> IO UDP
openUDP = udp_socket N.connect
-- N.setSocketOption fd N.RecvTimeOut 1000
-- | Trivial 'UDP' server socket.
--
-- > import Control.Concurrent
--
-- > let {f fd = forever (recvMessage fd >>= print)
-- > ;t = udpServer "127.0.0.1" 57300}
-- > in void (forkIO (withTransport t f))
--
-- > let t = openUDP "127.0.0.1" 57300
-- > in withTransport t (\fd -> sendMessage fd (message "/n" []))
udpServer :: String -> Int -> IO UDP
udpServer = udp_socket N.bindSocket
-- | Send variant to send to specified address.
sendTo :: OSC o => UDP -> o -> N.SockAddr -> IO ()
sendTo (UDP fd) o a = do
-- C.L.sendTo does not exist
void (C.sendTo fd (encodeOSC o) a)
-- | Recv variant to collect message source address.
recvFrom :: UDP -> IO (Packet, N.SockAddr)
recvFrom (UDP fd) = do
-- C.L.recvFrom does not exist
(s,a) <- C.recvFrom fd 8192
return (decodePacket s,a)
hosc-0.15/Sound/OSC/Transport/FD/TCP.hs 0000644 0000000 0000000 00000002263 12416134203 015543 0 ustar 00 0000000 0000000 -- | OSC over TCP implementation.
module Sound.OSC.Transport.FD.TCP where
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Control.Monad {- base -}
import Network {- network -}
import System.IO {- base -}
import Sound.OSC.Class
import Sound.OSC.Coding
import Sound.OSC.Coding.Byte
import Sound.OSC.Transport.FD
-- | The TCP transport handle data type.
data TCP = TCP {tcpHandle :: Handle}
instance Transport TCP where
sendOSC (TCP fd) msg =
do let b = encodeOSC msg
n = fromIntegral (B.length b)
B.hPut fd (B.append (encode_u32 n) b)
hFlush fd
recvPacket (TCP fd) =
do b0 <- B.hGet fd 4
b1 <- B.hGet fd (fromIntegral (decode_u32 b0))
return (decodePacket b1)
close (TCP fd) = hClose fd
-- | Make a 'TCP' connection.
openTCP :: String -> Int -> IO TCP
openTCP host =
liftM TCP .
connectTo host .
PortNumber .
fromIntegral
-- | A trivial 'TCP' /OSC/ server.
tcpServer' :: Int -> (TCP -> IO ()) -> IO ()
tcpServer' p f = do
s <- listenOn (PortNumber (fromIntegral p))
(sequence_ . repeat) (do (fd, _, _) <- accept s
f (TCP fd)
return ())
hosc-0.15/Sound/OSC/Coding/ 0000755 0000000 0000000 00000000000 12416134203 013474 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Coding/Cast.hs 0000644 0000000 0000000 00000002431 12416134203 014722 0 ustar 00 0000000 0000000 -- | Bit-level type casts and byte layout string typecasts.
module Sound.OSC.Coding.Cast (f32_w32,w32_f32
,f64_w64,w64_f64
,str_cstr,cstr_str
,str_pstr,pstr_str) where
import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}
import Data.Char {- base -}
import Data.Word {- base -}
-- | The IEEE byte representation of a float.
f32_w32 :: Float -> Word32
f32_w32 = I.floatToWord
-- | Inverse of 'f32_w32'.
w32_f32 :: Word32 -> Float
w32_f32 = I.wordToFloat
-- | The IEEE byte representation of a double.
f64_w64 :: Double -> Word64
f64_w64 = I.doubleToWord
-- | Inverse of 'f64_i64'.
w64_f64 :: Word64 -> Double
w64_f64 = I.wordToDouble
-- | Transform a haskell string into a C string (a null suffixed byte
-- string).
str_cstr :: String -> [Word8]
str_cstr s = map (fromIntegral . ord) s ++ [0]
-- | Inverse of 'str_cstr'.
cstr_str :: [Word8] -> String
cstr_str = map (chr . fromIntegral) . takeWhile (/= 0)
-- | Transform a haskell string to a pascal string (a length prefixed
-- byte string).
str_pstr :: String -> [Word8]
str_pstr s = fromIntegral (length s) : map (fromIntegral . ord) s
-- | Inverse of 'str_pstr'.
pstr_str :: [Word8] -> String
pstr_str = map (chr . fromIntegral) . drop 1
hosc-0.15/Sound/OSC/Coding/Byte.hs 0000644 0000000 0000000 00000006346 12416134203 014744 0 ustar 00 0000000 0000000 -- | Byte-level coding utility functions.
module Sound.OSC.Coding.Byte where
import Data.Binary {- base -}
import Data.Bits {- base -}
import qualified Data.ByteString as S {- bytestring -}
import qualified Data.ByteString.Char8 as S.C {- bytestring -}
import qualified Data.ByteString.Lazy as L {- bytestring -}
import qualified Data.ByteString.Lazy.Char8 as L.C {- bytestring -}
import Data.Int {- base -}
import Sound.OSC.Coding.Cast
import Sound.OSC.Type
-- | Encode a signed 8-bit integer.
encode_i8 :: Int -> L.ByteString
encode_i8 n = encode (fromIntegral n :: Int8)
-- | Encode an un-signed 8-bit integer.
encode_u8 :: Int -> L.ByteString
encode_u8 n = encode (fromIntegral n :: Word8)
-- | Encode a signed 16-bit integer.
encode_i16 :: Int -> L.ByteString
encode_i16 n = encode (fromIntegral n :: Int16)
-- | Encode a signed 32-bit integer.
encode_i32 :: Int -> L.ByteString
encode_i32 n = encode (fromIntegral n :: Int32)
-- | Encode an unsigned 16-bit integer.
encode_u32 :: Int -> L.ByteString
encode_u32 n = encode (fromIntegral n :: Word32)
-- | Encode a signed 64-bit integer.
encode_i64 :: Int64 -> L.ByteString
encode_i64 = encode
-- | Encode an unsigned 64-bit integer.
encode_u64 :: Word64 -> L.ByteString
encode_u64 = encode
-- | Encode a 32-bit IEEE floating point number.
encode_f32 :: Float -> L.ByteString
encode_f32 = encode . f32_w32
-- | Encode a 64-bit IEEE floating point number.
encode_f64 :: Double -> L.ByteString
encode_f64 = encode . f64_w64
-- | Encode an ASCII string.
encode_str :: ASCII -> L.ByteString
{-# INLINE encode_str #-}
encode_str = L.pack . S.unpack
-- | Decode an un-signed 8-bit integer.
decode_u8 :: L.ByteString -> Int
decode_u8 = fromIntegral . L.head
-- | Decode a signed 8-bit integer.
decode_i8 :: L.ByteString -> Int
decode_i8 b = fromIntegral (decode b :: Int8)
-- | Decode a signed 16-bit integer.
decode_i16 :: L.ByteString -> Int
decode_i16 b = fromIntegral (decode b :: Int16)
-- | Decode a signed 32-bit integer.
decode_i32 :: L.ByteString -> Int
decode_i32 b = fromIntegral (decode b :: Int32)
-- | Decode an unsigned 32-bit integer.
decode_u32 :: L.ByteString -> Int
decode_u32 b = fromIntegral (decode b :: Word32)
-- | Decode a signed 64-bit integer.
decode_i64 :: L.ByteString -> Int64
decode_i64 = decode
-- | Decode an unsigned 64-bit integer.
decode_u64 :: L.ByteString -> Word64
decode_u64 = decode
-- | Decode a 32-bit IEEE floating point number.
decode_f32 :: L.ByteString -> Float
decode_f32 b = w32_f32 (decode b :: Word32)
-- | Decode a 64-bit IEEE floating point number.
decode_f64 :: L.ByteString -> Double
decode_f64 b = w64_f64 (decode b :: Word64)
-- | Decode an ASCII string.
decode_str :: L.ByteString -> ASCII
{-# INLINE decode_str #-}
decode_str = S.C.pack . L.C.unpack
-- | Bundle header as a (strict) 'S.C.ByteString'.
bundleHeader_strict :: S.C.ByteString
bundleHeader_strict = S.C.pack "#bundle\0"
-- | Bundle header as a lazy ByteString.
bundleHeader :: L.ByteString
{-# INLINE bundleHeader #-}
bundleHeader = L.C.fromChunks [bundleHeader_strict]
-- | The number of bytes required to align an OSC value to the next
-- 4-byte boundary.
--
-- > map align [0::Int .. 7] == [0,3,2,1,0,3,2,1]
align :: (Num i,Bits i) => i -> i
{-# INLINE align #-}
align n = ((n + 3) .&. complement 3) - n
hosc-0.15/Sound/OSC/Coding/Decode/ 0000755 0000000 0000000 00000000000 12416134203 014657 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Coding/Decode/Binary.hs 0000644 0000000 0000000 00000007365 12416134203 016452 0 ustar 00 0000000 0000000 -- | Optimised decode function for OSC packets.
module Sound.OSC.Coding.Decode.Binary
(getPacket
,decodePacket
,decodePacket_strict) where
import Control.Applicative {- base -}
import Control.Monad (when) {- base -}
import qualified Data.Binary.Get as G {- binary -}
import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}
import qualified Data.ByteString.Char8 as S.C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}
import Data.Int {- base -}
import Data.Word {- base -}
import Sound.OSC.Coding.Byte
import Sound.OSC.Time
import Sound.OSC.Type
-- | Get a 32 bit integer in big-endian byte order.
getInt32be :: G.Get Int32
getInt32be = fromIntegral <$> G.getWord32be
-- | Get a 64 bit integer in big-endian byte order.
getInt64be :: G.Get Int64
getInt64be = fromIntegral <$> G.getWord64be
-- | Get an aligned OSC string.
get_string :: G.Get String
get_string = do
s <- G.getLazyByteStringNul
G.skip (fromIntegral (align (B.length s + 1)))
return $ C.unpack s
-- | Get an aligned OSC string.
get_ascii :: G.Get ASCII
get_ascii = do
s <- G.getLazyByteStringNul
G.skip (fromIntegral (align (B.length s + 1)))
return (S.C.pack (C.unpack s))
-- | Get binary data prefixed by byte count.
get_bytes :: Word32 -> G.Get B.ByteString
get_bytes n = do
b <- G.getLazyByteString (fromIntegral n)
if n /= fromIntegral (B.length b)
then fail "get_bytes: end of stream"
else G.skip (fromIntegral (align n))
return b
-- | Get an OSC datum.
get_datum :: Datum_Type -> G.Get Datum
get_datum ty =
case ty of
'i' -> Int32 <$> fromIntegral <$> getInt32be
'h' -> Int64 <$> fromIntegral <$> getInt64be
'f' -> Float <$> realToFrac <$> I.getFloat32be
'd' -> Double <$> I.getFloat64be
's' -> ASCII_String <$> get_ascii
'b' -> Blob <$> (get_bytes =<< G.getWord32be)
't' -> TimeStamp <$> ntpi_to_ntpr <$> G.getWord64be
'm' -> do b0 <- G.getWord8
b1 <- G.getWord8
b2 <- G.getWord8
b3 <- G.getWord8
return $ Midi (MIDI b0 b1 b2 b3)
_ -> fail ("get_datum: illegal type " ++ show ty)
-- | Get an OSC 'Message'.
get_message :: G.Get Message
get_message = do
cmd <- get_string
dsc <- get_ascii
case S.C.unpack dsc of
',':tags -> do
arg <- mapM get_datum tags
return $ Message cmd arg
_ -> fail "get_message: invalid type descriptor string"
-- | Get a sequence of OSC 'Message's, each one headed by its length.
get_message_seq :: G.Get [Message]
get_message_seq = do
b <- G.isEmpty
if b
then return []
else do
p <- flip G.isolate get_message . fromIntegral =<< G.getWord32be
ps <- get_message_seq
return (p:ps)
-- | Get a bundle. Fail if bundle header is not found in packet.
get_bundle :: G.Get Bundle
get_bundle = do
h <- G.getByteString (S.C.length bundleHeader_strict)
when (h /= bundleHeader_strict) (fail "get_bundle: not a bundle")
t <- ntpi_to_ntpr <$> G.getWord64be
ps <- get_message_seq
return $ Bundle t ps
-- | Get an OSC 'Packet'.
getPacket :: G.Get Packet
getPacket = (Packet_Bundle <$> get_bundle) <|> (Packet_Message <$> get_message)
-- | 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]
-- > in decodeOSC b == Message "/g_free" [Int 0]
decodePacket :: B.ByteString -> Packet
{-# INLINE decodePacket #-}
decodePacket = G.runGet getPacket
-- | Decode an OSC packet from a strict ByteString.
decodePacket_strict :: S.C.ByteString -> Packet
{-# INLINE decodePacket_strict #-}
decodePacket_strict = G.runGet getPacket . B.fromChunks . (:[])
hosc-0.15/Sound/OSC/Coding/Decode/Base.hs 0000644 0000000 0000000 00000007045 12416134203 016073 0 ustar 00 0000000 0000000 -- | Base-level decode function for OSC packets (slow). For ordinary
-- use see 'Sound.OSC.Coding.Decode.Binary'.
module Sound.OSC.Coding.Decode.Base (decodeMessage
,decodeBundle
,decodePacket) where
import Data.Binary {- base -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Sound.OSC.Coding.Byte
import Sound.OSC.Time
import Sound.OSC.Type
-- The plain byte count of an OSC value.
size :: Datum_Type -> B.ByteString -> Int
size ty b =
case ty of
'i' -> 4
'f' -> 4
'd' -> 8
't' -> 8 -- timetag
'm' -> 4 -- MIDI message
's' -> fromIntegral (fromMaybe
(error ("size: no terminating zero: " ++ show b))
(B.elemIndex 0 b))
'b' -> decode_i32 (B.take 4 b)
_ -> error "size: illegal type"
-- The storage byte count of an OSC value.
storage :: Datum_Type -> B.ByteString -> Int
storage ty b =
case ty of
's' -> let n = size 's' b + 1 in n + align n
'b' -> let n = size 'b' b in n + align n + 4
_ -> size ty B.empty
-- Decode an OSC datum
decode_datum :: Datum_Type -> B.ByteString -> Datum
decode_datum ty b =
case ty of
'i' -> Int32 (decode b)
'h' -> Int64 (decode b)
'f' -> Float (decode_f32 b)
'd' -> Double (decode_f64 b)
's' -> ASCII_String (decode_str (b_take (size 's' b) b))
'b' -> Blob (b_take (size 'b' b) (B.drop 4 b))
't' -> TimeStamp (ntpi_to_ntpr (decode_u64 b))
'm' -> let [b0,b1,b2,b3] = B.unpack (B.take 4 b)
in midi (b0,b1,b2,b3)
_ -> error ("decode_datum: illegal type (" ++ [ty] ++ ")")
-- Decode a sequence of OSC datum given a type descriptor string.
decode_datum_seq :: ASCII -> B.ByteString -> [Datum]
decode_datum_seq cs b =
let swap (x,y) = (y,x)
cs' = C.unpack cs
f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')
in zipWith decode_datum cs' (snd (mapAccumL f b cs'))
-- | Decode an OSC 'Message'.
decodeMessage :: B.ByteString -> Message
decodeMessage b =
let n = storage 's' b
(ASCII_String cmd) = decode_datum 's' b
m = storage 's' (b_drop n b)
(ASCII_String dsc) = decode_datum 's' (b_drop n b)
arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b)
in Message (C.unpack cmd) arg
-- Decode a sequence of OSC messages, each one headed by its length
decode_message_seq :: B.ByteString -> [Message]
decode_message_seq b =
let s = decode_i32 b
m = decodeMessage (b_drop 4 b)
nxt = decode_message_seq (b_drop (4+s) b)
in if B.length b == 0 then [] else m:nxt
-- | Decode an OSC 'Bundle'.
decodeBundle :: B.ByteString -> Bundle
decodeBundle b =
let h = storage 's' b -- header (should be '#bundle')
t = storage 't' (b_drop h b) -- time tag
(TimeStamp timeStamp) = decode_datum 't' (b_drop h b)
ms = decode_message_seq (b_drop (h+t) b)
in Bundle timeStamp ms
-- | Decode an OSC 'Packet'.
--
-- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
-- > in decodePacket b == Message "/g_free" [Int 0]
decodePacket :: B.ByteString -> Packet
decodePacket b =
if bundleHeader `B.isPrefixOf` b
then Packet_Bundle (decodeBundle b)
else Packet_Message (decodeMessage b)
b_take :: Int -> B.ByteString -> B.ByteString
b_take = B.take . fromIntegral
b_drop :: Int -> B.ByteString -> B.ByteString
b_drop = B.drop . fromIntegral
hosc-0.15/Sound/OSC/Coding/Encode/ 0000755 0000000 0000000 00000000000 12416134203 014671 5 ustar 00 0000000 0000000 hosc-0.15/Sound/OSC/Coding/Encode/Base.hs 0000644 0000000 0000000 00000003607 12416134203 016105 0 ustar 00 0000000 0000000 -- | Base-level encode function for OSC packets (slow). For ordinary
-- use see 'Sound.OSC.Coding.Encode.Builder'.
module Sound.OSC.Coding.Encode.Base (encodeMessage
,encodeBundle
,encodePacket) where
import Data.Binary {- base -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Sound.OSC.Coding.Byte
import Sound.OSC.Type
import Sound.OSC.Time
-- Align a byte string if required.
extend :: Word8 -> B.ByteString -> B.ByteString
extend p s = B.append s (B.replicate (align (B.length s)) p)
-- Encode an OSC datum.
encode_datum :: Datum -> B.ByteString
encode_datum dt =
case dt of
Int32 i -> encode i
Int64 i -> encode i
Float f -> encode_f32 f
Double d -> encode_f64 d
TimeStamp t -> encode_u64 $ ntpr_to_ntpi t
ASCII_String s -> extend 0 (B.snoc (encode_str s) 0)
Midi (MIDI b0 b1 b2 b3) -> B.pack [b0,b1,b2,b3]
Blob b -> let n = encode_i32 (fromIntegral (B.length b))
in B.append n (extend 0 b)
-- | Encode an OSC 'Message'.
encodeMessage :: Message -> B.ByteString
encodeMessage (Message c l) =
B.concat [encode_datum (ASCII_String (C.pack c))
,encode_datum (ASCII_String (descriptor l))
,B.concat (map encode_datum l) ]
-- Encode an OSC 'Message' as an OSC blob.
encode_message_blob :: Message -> Datum
encode_message_blob = Blob . encodeMessage
-- | Encode an OSC 'Bundle'.
encodeBundle :: Bundle -> B.ByteString
encodeBundle (Bundle t m) =
B.concat [bundleHeader
,encode_u64 (ntpr_to_ntpi t)
,B.concat (map (encode_datum . encode_message_blob) m)]
-- | Encode an OSC 'Packet'.
encodePacket :: Packet -> B.ByteString
encodePacket o =
case o of
Packet_Message m -> encodeMessage m
Packet_Bundle b -> encodeBundle b
hosc-0.15/Sound/OSC/Coding/Encode/Builder.hs 0000644 0000000 0000000 00000006552 12416134203 016623 0 ustar 00 0000000 0000000 -- | Optimised encode function for OSC packets.
module Sound.OSC.Coding.Encode.Builder
(build_packet
,encodeMessage
,encodeBundle
,encodePacket
,encodePacket_strict) where
import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}
import qualified Data.ByteString as S {- bytestring -}
import qualified Data.ByteString.Lazy as L {- bytestring -}
import qualified Blaze.ByteString.Builder as B {- bytestring -}
import qualified Blaze.ByteString.Builder.Char8 as B {- bytestring -}
import Data.Monoid (mappend, mconcat) {- base -}
import Data.Word (Word8) {- base -}
import Sound.OSC.Coding.Byte (align, bundleHeader)
import Sound.OSC.Time
import Sound.OSC.Type
-- Generate a list of zero bytes for padding.
padding :: Integral i => i -> [Word8]
padding n = replicate (fromIntegral n) 0
-- Encode a string with zero padding.
build_ascii :: ASCII -> B.Builder
build_ascii s = B.fromByteString s `mappend` B.fromWord8s (0:padding (align (S.length s + 1)))
-- Encode a string with zero padding.
build_string :: String -> B.Builder
build_string s = B.fromString s `mappend` B.fromWord8s (0:padding (align (length s + 1)))
-- Encode a byte string with prepended length and zero padding.
build_bytes :: L.ByteString -> B.Builder
build_bytes s = B.fromInt32be (fromIntegral (L.length s))
`mappend` B.fromLazyByteString s
`mappend` B.fromWord8s (padding (align (L.length s)))
-- Encode an OSC datum.
build_datum :: Datum -> B.Builder
build_datum d =
case d of
Int32 i -> B.fromInt32be (fromIntegral i)
Int64 i -> B.fromInt64be (fromIntegral i)
Float n -> B.fromWord32be (I.floatToWord (realToFrac n))
Double n -> B.fromWord64be (I.doubleToWord n)
TimeStamp t -> B.fromWord64be (fromIntegral (ntpr_to_ntpi t))
ASCII_String s -> build_ascii s
Midi (MIDI b0 b1 b2 b3) -> B.fromWord8s [b0,b1,b2,b3]
Blob b -> build_bytes b
-- Encode an OSC 'Message'.
build_message :: Message -> B.Builder
build_message (Message c l) =
mconcat [build_string c
,build_ascii (descriptor l)
,mconcat $ map build_datum l]
-- Encode an OSC 'Bundle'.
build_bundle_ntpi :: NTPi -> [Message] -> B.Builder
build_bundle_ntpi t l =
mconcat [B.fromLazyByteString bundleHeader
,B.fromWord64be t
,mconcat $ map (build_bytes . B.toLazyByteString . build_message) l]
-- | Builder monoid for an OSC 'Packet'.
build_packet :: Packet -> B.Builder
build_packet o =
case o of
Packet_Message m -> build_message m
Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m
{-# INLINE encodeMessage #-}
{-# INLINE encodeBundle #-}
{-# INLINE encodePacket #-}
{-# INLINE encodePacket_strict #-}
-- | Encode an OSC 'Message'.
encodeMessage :: Message -> L.ByteString
encodeMessage = B.toLazyByteString . build_packet . Packet_Message
-- | Encode an OSC 'Bundle'.
encodeBundle :: Bundle -> L.ByteString
encodeBundle = B.toLazyByteString . build_packet . Packet_Bundle
-- | Encode an OSC 'Packet' to a lazy 'L.ByteString'.
--
-- > let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
-- > in encodeOSC (Message "/g_free" [Int 0]) == b
encodePacket :: Packet -> L.ByteString
encodePacket = B.toLazyByteString . build_packet
-- | Encode an Packet packet to a strict ByteString.
encodePacket_strict :: Packet -> S.ByteString
encodePacket_strict = B.toByteString . build_packet
hosc-0.15/tests/ 0000755 0000000 0000000 00000000000 12416134203 011717 5 ustar 00 0000000 0000000 hosc-0.15/tests/test.hs 0000644 0000000 0000000 00000001710 12416134203 013231 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-}
import Sound.OSC.Arbitrary ()
import qualified Sound.OSC.Coding.Decode.Base as DecodeBase
import qualified Sound.OSC.Coding.Encode.Base as EncodeBase
import qualified Sound.OSC.Coding.Decode.Binary as DecodeBinary
import qualified Sound.OSC.Coding.Encode.Builder as EncodeBuilder
import Sound.OSC.Type (Packet)
import Test.Framework (Test, defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
tests :: [Test]
tests =
[ testProperty "encodePacket (Builder)" $ \(osc :: Packet) ->
EncodeBuilder.encodePacket osc == EncodeBase.encodePacket osc
, testProperty "encodePacket/decodePacket" $ \(osc :: Packet) ->
DecodeBase.decodePacket (EncodeBase.encodePacket osc) == osc
, testProperty "decodePacket (Get)" $ \(osc :: Packet) ->
DecodeBinary.decodePacket (EncodeBase.encodePacket osc) == osc
]
main :: IO ()
main = defaultMain tests
hosc-0.15/tests/Sound/ 0000755 0000000 0000000 00000000000 12416134203 013007 5 ustar 00 0000000 0000000 hosc-0.15/tests/Sound/OSC/ 0000755 0000000 0000000 00000000000 12416134203 013433 5 ustar 00 0000000 0000000 hosc-0.15/tests/Sound/OSC/Arbitrary.hs 0000644 0000000 0000000 00000002246 12416134203 015732 0 ustar 00 0000000 0000000 module Sound.OSC.Arbitrary () where
import Control.Applicative {- base -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Test.QuickCheck {- QuickCheck -}
import Sound.OSC
-- Avoid floating point representation/conversion errors
genTime :: Gen Time
genTime = ntpi_to_ntpr <$> arbitrary
genString :: Gen String
genString = resize 128 (listOf (arbitrary `suchThat` (/= '\0')))
genASCII :: Gen ASCII
genASCII = fmap C.pack genString
genMIDI :: Gen MIDI
genMIDI = do
(p,q,r,s) <- arbitrary
return (MIDI p q r s)
instance Arbitrary Datum where
arbitrary = oneof [
Int32 <$> arbitrary
, Float <$> realToFrac <$> (arbitrary :: Gen Float)
, Double <$> arbitrary
, ASCII_String <$> genASCII
, Blob <$> B.pack <$> resize 128 arbitrary
, TimeStamp <$> genTime
, Midi <$> genMIDI
]
genMessage :: Gen Message
genMessage = message <$> ("/"++) <$> genString <*> resize 32 (listOf1 arbitrary)
instance Arbitrary Packet where
arbitrary = oneof [
Packet_Message <$> genMessage
, p_bundle <$> genTime <*> resize 32 (listOf1 genMessage)
]
hosc-0.15/benchmarks/ 0000755 0000000 0000000 00000000000 12416134203 012672 5 ustar 00 0000000 0000000 hosc-0.15/benchmarks/benchmark.hs 0000644 0000000 0000000 00000002176 12416134203 015166 0 ustar 00 0000000 0000000 import Criterion.Main {- criterion -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Sound.OSC
import qualified Sound.OSC.Coding.Decode.Binary as Binary
import qualified Sound.OSC.Coding.Encode.Builder as Builder
import qualified Sound.OSC.Coding.Decode.Base as Decode
import qualified Sound.OSC.Coding.Encode.Base as Encode
import Sound.OSC.NFData ()
type EncodingFunc = Bundle -> B.ByteString
type DecodingFunc = B.ByteString -> Packet
main :: IO ()
main =
defaultMain [
bgroup "encodeOSC" [
bench "Encode" (nf (Encode.encodeBundle :: EncodingFunc) b)
, bench "Builder" (nf (Builder.encodeBundle :: EncodingFunc) b)
]
, bgroup "decodeOSC" [
bench "Decode" (nf (Decode.decodePacket :: DecodingFunc) p)
, bench "Binary" (nf (Binary.decodePacket :: DecodingFunc) p)
]
]
where
m = Message "/fooblah" [Float 42.0
,Int32 16
,string "yeah"
,Blob (B.pack [0..128])]
b = Bundle pi (replicate 12 m)
p = Encode.encodeBundle b
hosc-0.15/benchmarks/Sound/ 0000755 0000000 0000000 00000000000 12416134203 013762 5 ustar 00 0000000 0000000 hosc-0.15/benchmarks/Sound/OSC/ 0000755 0000000 0000000 00000000000 12416134203 014406 5 ustar 00 0000000 0000000 hosc-0.15/benchmarks/Sound/OSC/NFData.hs 0000644 0000000 0000000 00000001450 12416134203 016037 0 ustar 00 0000000 0000000 module Sound.OSC.NFData () where
import Control.DeepSeq (NFData(..)) {- deepseq -}
import Sound.OSC.Type
instance NFData Datum where
rnf (Int32 x1) = rnf x1 `seq` ()
rnf (Float x1) = rnf x1 `seq` ()
rnf (Double x1) = rnf x1 `seq` ()
rnf (ASCII_String x1) = rnf x1 `seq` ()
rnf (Blob x1) = rnf x1 `seq` ()
rnf (TimeStamp x1) = rnf x1 `seq` ()
rnf (Midi x1) = rnf x1 `seq` ()
instance NFData MIDI where
rnf (MIDI x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
instance NFData Message where
rnf (Message x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
instance NFData Bundle where
rnf (Bundle x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
instance NFData Packet where
rnf (Packet_Message x1) = rnf x1 `seq` ()
rnf (Packet_Bundle x1) = rnf x1 `seq` ()