hosc-0.15/0000755000000000000000000000000012416134203010555 5ustar0000000000000000hosc-0.15/hosc.cabal0000644000000000000000000000613612416134203012503 0ustar0000000000000000Name: 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.hs0000644000000000000000000000011012416134203012201 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hosc-0.15/README0000644000000000000000000000177012416134203011442 0ustar0000000000000000hosc - 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/0000755000000000000000000000000012416134203011645 5ustar0000000000000000hosc-0.15/Sound/OSC.hs0000644000000000000000000000045212416134203012626 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203012271 5ustar0000000000000000hosc-0.15/Sound/OSC/Normalise.hs0000644000000000000000000000367612416134203014572 0ustar0000000000000000-- | 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.hs0000644000000000000000000000352712416134203013706 0ustar0000000000000000-- | '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.hs0000644000000000000000000000133012416134203013526 0ustar0000000000000000-- | 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.hs0000644000000000000000000000127312416134203013520 0ustar0000000000000000-- | 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.hs0000644000000000000000000000330712416134203014033 0ustar0000000000000000{-# 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.hs0000644000000000000000000002756312416134203013563 0ustar0000000000000000-- | 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.hs0000644000000000000000000000152212416134203013672 0ustar0000000000000000-- | 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.hs0000644000000000000000000000036312416134203013120 0ustar0000000000000000-- | 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.hs0000644000000000000000000000672312416134203013533 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203014265 5ustar0000000000000000hosc-0.15/Sound/OSC/Transport/Monad.hs0000644000000000000000000000730712416134203015666 0ustar0000000000000000-- | 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.hs0000644000000000000000000000641012416134203015113 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203014556 5ustar0000000000000000hosc-0.15/Sound/OSC/Transport/FD/UDP.hs0000644000000000000000000000405512416134203015546 0ustar0000000000000000-- | 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.hs0000644000000000000000000000226312416134203015543 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203013474 5ustar0000000000000000hosc-0.15/Sound/OSC/Coding/Cast.hs0000644000000000000000000000243112416134203014722 0ustar0000000000000000-- | 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.hs0000644000000000000000000000634612416134203014744 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203014657 5ustar0000000000000000hosc-0.15/Sound/OSC/Coding/Decode/Binary.hs0000644000000000000000000000736512416134203016452 0ustar0000000000000000-- | 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.hs0000644000000000000000000000704512416134203016073 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203014671 5ustar0000000000000000hosc-0.15/Sound/OSC/Coding/Encode/Base.hs0000644000000000000000000000360712416134203016105 0ustar0000000000000000-- | 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.hs0000644000000000000000000000655212416134203016623 0ustar0000000000000000-- | 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/0000755000000000000000000000000012416134203011717 5ustar0000000000000000hosc-0.15/tests/test.hs0000644000000000000000000000171012416134203013231 0ustar0000000000000000{-# 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/0000755000000000000000000000000012416134203013007 5ustar0000000000000000hosc-0.15/tests/Sound/OSC/0000755000000000000000000000000012416134203013433 5ustar0000000000000000hosc-0.15/tests/Sound/OSC/Arbitrary.hs0000644000000000000000000000224612416134203015732 0ustar0000000000000000module 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/0000755000000000000000000000000012416134203012672 5ustar0000000000000000hosc-0.15/benchmarks/benchmark.hs0000644000000000000000000000217612416134203015166 0ustar0000000000000000import 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/0000755000000000000000000000000012416134203013762 5ustar0000000000000000hosc-0.15/benchmarks/Sound/OSC/0000755000000000000000000000000012416134203014406 5ustar0000000000000000hosc-0.15/benchmarks/Sound/OSC/NFData.hs0000644000000000000000000000145012416134203016037 0ustar0000000000000000module 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` ()