hosc-0.17/0000755000000000000000000000000013406330137010563 5ustar0000000000000000hosc-0.17/hosc.cabal0000644000000000000000000000354413406330137012511 0ustar0000000000000000Name: hosc Version: 0.17 Synopsis: Haskell Open Sound Control Description: @hosc@ implements a subset of the Open Sound Control byte protocol, . . See "Sound.OSC.Core" or "Sound.OSC" or "Sound.OSC.FD". License: GPL-3 Category: Sound Copyright: (c) Rohan Drape, Stefan Kersten and others, 2007-2018 Author: Rohan Drape, Stefan Kersten Maintainer: rd@rohandrape.net Stability: Experimental Homepage: http://rohandrape.net/t/hosc Tested-With: GHC == 8.4.3 Build-Type: Simple Cabal-Version: >= 1.8 Data-Files: README Library Build-Depends: base >= 4.8 && < 5, binary >= 0.7.2, blaze-builder >= 0.3, bytestring, data-binary-ieee754, network >= 2.3, time >= 1.5, transformers GHC-Options: -Wall -fwarn-tabs Exposed-modules: Sound.OSC Sound.OSC.Coding.Byte Sound.OSC.Coding.Cast Sound.OSC.Coding.Convert 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.Packet Sound.OSC.Time Sound.OSC.Transport.FD Sound.OSC.Transport.FD.TCP Sound.OSC.Transport.FD.UDP Sound.OSC.Transport.Monad Sound.OSC.Wait Source-Repository head Type: git Location: https://github.com/rd--/hosc.git hosc-0.17/Setup.hs0000644000000000000000000000011013406330137012207 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hosc-0.17/README0000644000000000000000000000161213406330137011443 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. See also: - [hosc-json](?t=hosc-json): JSON text encoding of OSC © [rohan drape][rd], [stefan kersten][sk] and others, 2007-2018, [gpl][gpl]. with contributions by: - [alex mclean][am] - [henning thielemann][ht] see the [git](https://git-scm.com/) [history](?t=hosc&q=history) for details [hosc]: http://rohandrape.net/?t=hosc [hs]: http://haskell.org/ [osc]: http://opensoundcontrol.org/ [hsc3]: http://rohandrape.net/?t=hsc3 [sc3]: http://audiosynth.com/ [rd]: http://rohandrape.net/ [sk]: http://space.k-hornz.de/ [am]: http://yaxu.org/ [ht]: http://www.henning-thielemann.de/Research.html [gpl]: http://gnu.org/copyleft/ hosc-0.17/Sound/0000755000000000000000000000000013406330137011653 5ustar0000000000000000hosc-0.17/Sound/OSC.hs0000644000000000000000000000045213406330137012634 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.17/Sound/OSC/0000755000000000000000000000000013406330137012277 5ustar0000000000000000hosc-0.17/Sound/OSC/Datum.hs0000644000000000000000000001757213406330137013721 0ustar0000000000000000-- | Data type for OSC datum. module Sound.OSC.Datum where import Data.Int {- base -} import Data.List {- base -} import Data.Maybe {- base -} import Data.Word {- base -} import Numeric {- base -} import Text.Read {- base -} import qualified Data.ByteString.Lazy as Lazy {- bytestring -} import qualified Data.ByteString.Char8 as Char8 {- bytestring -} import qualified Sound.OSC.Time as Time {- hosc -} -- * Datum -- | Type enumerating Datum categories. type Datum_Type = Char -- | Type for ASCII strings (strict 'Char'8 'Char8.ByteString'). type ASCII = Char8.ByteString -- | Type-specialised 'Char8.pack'. ascii :: String -> ASCII ascii = Char8.pack -- | Type-specialised 'Char8.unpack'. ascii_to_string :: ASCII -> String ascii_to_string = Char8.unpack -- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix. type BLOB = Lazy.ByteString -- | Type-specialised 'Lazy.pack'. blob_pack :: [Word8] -> BLOB blob_pack = Lazy.pack -- | Type-specialised 'Lazy.unpack'. blob_unpack :: BLOB -> [Word8] blob_unpack = Lazy.unpack -- | Four-byte midi message: port-id, status-byte, data, data. 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 :: BLOB} | TimeStamp {d_timestamp :: Time.Time} -- ie. NTPr | Midi {d_midi :: MIDI} deriving (Eq,Read,Show) -- * Datum types -- | List of required data types (tag,name). osc_types_required :: [(Datum_Type,String)] osc_types_required = [('i',"Int32") ,('f',"Float") ,('s',"ASCII_String") -- ASCII ,('b',"ByteArray") -- Blob ] -- | List of optional data types (tag,name). osc_types_optional :: [(Datum_Type,String)] osc_types_optional = [('h',"Int64") ,('t',"TimeStamp") ,('d',"Double") -- ,('S',"Symbol") -- ,('c',"ASCII_Character") -- ,('r',"RGBA") ,('m',"MIDI") -- ,('T',"True") -- ,('F',"False") -- ,('N',"Nil") -- ,('I',"Infinitum") -- ,('[',"Array_Begin") -- ,(']',"Array_End") ] -- | List of all data types (tag,name). osc_types :: [(Datum_Type,String)] osc_types = osc_types_required ++ osc_types_optional -- | Lookup name of type. osc_type_name :: Datum_Type -> Maybe String osc_type_name c = lookup c osc_types -- | Erroring variant. osc_type_name_err :: Datum_Type -> String osc_type_name_err = fromMaybe (error "osc_type_name") . osc_type_name -- | Single character identifier of an OSC datum. datum_tag :: Datum -> Datum_Type datum_tag d = case d of Int32 _ -> 'i' Int64 _ -> 'h' Float _ -> 'f' Double _ -> 'd' ASCII_String _ -> 's' Blob _ -> 'b' TimeStamp _ -> 't' Midi _ -> 'm' -- | Type and name of 'Datum'. datum_type_name :: Datum -> (Datum_Type,String) datum_type_name d = let c = datum_tag d in (c,osc_type_name_err c) -- * Generalised element access -- | 'Datum' as 'Integral' if Int32 or Int64. -- -- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5] -- > map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing] datum_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 Int32, Int64, Float, Double or TimeStamp. -- -- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5] -- > mapMaybe datum_floating d == replicate 5 (5::Double) 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 -- * Constructors -- | Type generalised 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 Int64. -- -- > int64 (1::Int32) == int64 (1::Integer) -- > d_int64 (int64 (maxBound::Int64)) == maxBound int64 :: Integral n => n -> Datum int64 = Int64 . fromIntegral -- | Type generalised 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 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 'Char8.pack'. -- -- > string "string" == ASCII_String (Char8.pack "string") string :: String -> Datum string = ASCII_String . Char8.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) -- * Descriptor -- | Message argument types are given by a descriptor. -- -- > descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs" descriptor :: [Datum] -> ASCII descriptor l = Char8.pack (',' : map datum_tag l) -- | Descriptor tags are @comma@ prefixed. descriptor_tags :: ASCII -> ASCII descriptor_tags = Char8.drop 1 -- * 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.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 (Just 5)) 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 (Char8.unpack s) Blob s -> show s TimeStamp t -> timePP p t Midi (MIDI b1 b2 b3 b4) -> vecPP [b1,b2,b3,b4] -- | Variant of 'datumPP' that appends the 'datum_type_name'. datum_pp_typed :: FP_Precision -> Datum -> String datum_pp_typed fp d = datumPP fp d ++ ":" ++ snd (datum_type_name d) -- * Parser -- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'. -- -- > parse_datum 'i' "42" == Just (Int32 42) -- > parse_datum 'h' "42" == Just (Int64 42) -- > parse_datum 'f' "3.14159" == Just (Float 3.14159) -- > parse_datum 'd' "3.14159" == Just (Double 3.14159) -- > parse_datum 's' "\"pi\"" == Just (string "pi") -- > parse_datum 'b' "[112,105]" == Just (Blob (blob_pack [112,105])) -- > parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90)) parse_datum :: 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 . Char8.pack) . readMaybe 'b' -> fmap (Blob . blob_pack) . readMaybe 't' -> error "parse_datum: timestamp not implemented" 'm' -> fmap midi . readMaybe _ -> error "parse_datum: unknown type" -- | Erroring variant of 'parse_datum'. parse_datum_err :: Datum_Type -> String -> Datum parse_datum_err ty = fromMaybe (error "parse_datum") . parse_datum ty hosc-0.17/Sound/OSC/Wait.hs0000644000000000000000000000134113406330137013536 0ustar0000000000000000-- | Waiting (for replies). module Sound.OSC.Wait where import System.Timeout {- base -} -- * Timeout -- | Variant of 'timeout' where time is given in fractional seconds. timeout_r :: Double -> IO a -> IO (Maybe a) timeout_r = timeout . floor . (* 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 recur else return p recur = act >>= g in recur -- | 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 = maybe recur return (f p) recur = act >>= g in recur hosc-0.17/Sound/OSC/Core.hs0000644000000000000000000000110313406330137013516 0ustar0000000000000000{- | Composite of non-transport related modules. Provides the 'Datum', 'Message', 'Time', 'Bundle' and 'Packet' types and the coding functions 'encodePacket' and 'decodePacket'. > import Sound.OSC.Core {- hosc -} > > let o = bundle immediately [message "/g_free" [Int32 0]] > let e = encodeBundle o > decodePacket e == Packet_Bundle o -} module Sound.OSC.Core (module M) where import Sound.OSC.Coding.Decode.Binary as M import Sound.OSC.Coding.Encode.Builder as M import Sound.OSC.Datum as M import Sound.OSC.Packet as M import Sound.OSC.Time as M import Sound.OSC.Wait as M hosc-0.17/Sound/OSC/Packet.hs0000644000000000000000000001050413406330137014042 0ustar0000000000000000-- | Data types for OSC messages, bundles and packets. module Sound.OSC.Packet where import Data.List {- base -} import Sound.OSC.Datum {- hosc3 -} import Sound.OSC.Time {- hosc3 -} -- * Message -- | OSC address pattern. This is strictly an ASCII value, however it -- is very common to pattern match on addresses and matching on -- 'C.ByteString' requires @OverloadedStrings@. type Address_Pattern = String -- | An OSC message, an 'Address_Pattern' and a sequence of 'Datum'. 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" -- * Bundle -- | An OSC bundle, a 'Time' and a sequence of 'Message's. 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' of 'bundle'. p_bundle :: Time -> [Message] -> Packet p_bundle t = Packet_Bundle . bundle t -- | 'Packet_Message' of '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 -- | 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 hosc-0.17/Sound/OSC/FD.hs0000644000000000000000000000036313406330137013126 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.17/Sound/OSC/Time.hs0000644000000000000000000001353313406330137013536 0ustar0000000000000000-- | OSC related timing functions. -- OSC timestamps are 64-bit @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 -} -- * Temporal types -- | Type for binary (integeral) representation of a 64-bit @NTP@ timestamp (ie. @ntpi@). -- The NTP epoch is January 1, 1900. -- NTPv4 also includes a 128-bit format, which is not used by OSC. type NTP64 = Word64 -- | @NTP@ time in real-valued (fractional) form (ie. @ntpr@). -- This is the primary form of timestamp used by hosc. type Time = Double -- | Constant indicating a bundle to be executed immediately. -- It has the NTP64 representation of @1@. immediately :: Time immediately = 1 / 2^(32::Int) -- | @Unix/Posix@ time in real-valued (fractional) form. -- The Unix/Posix epoch is January 1, 1970. type UT = Double -- * Time conversion -- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp. -- -- > ntpr_to_ntpi immediately == 1 -- > fmap ntpr_to_ntpi time ntpr_to_ntpi :: RealFrac n => n -> NTP64 ntpr_to_ntpi t = round (t * (2 ^ (32::Int))) -- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp. ntpi_to_ntpr :: Fractional n => NTP64 -> 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 -- > 25567 `div` 365 == 70 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 -> NTP64 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 :: NTP64 -> UT ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr -- | Convert 'Time' to 'T.POSIXTime'. ntpr_to_posixtime :: Time -> T.POSIXTime ntpr_to_posixtime = realToFrac . ntpr_to_ut -- | Convert 'T.POSIXTime' to 'Time'. posixtime_to_ntpr :: T.POSIXTime -> Time posixtime_to_ntpr = ut_to_ntpr . realToFrac -- * '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. > get_ct = fmap utc_to_ut T.getCurrentTime > get_pt = fmap realToFrac T.getPOSIXTime > (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1) > print (pt - ct,pt - ct < 1e-5) -} time :: MonadIO m => m Time time = liftIO (fmap posixtime_to_ntpr 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,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 -- * Pretty printing -- | Detailed 37-character ISO 8601 format, including fractional seconds and '+0000' suffix. iso_8601_fmt :: String iso_8601_fmt = "%Y-%m-%dT%H:%M:%S,%q+0000" -- | Parse time according to 'iso_8601_fmt' -- -- > iso_8601_to_utctime "2015-11-26T00:29:37,145875000000+0000" iso_8601_to_utctime :: String -> Maybe T.UTCTime iso_8601_to_utctime = T.parseTimeM True T.defaultTimeLocale iso_8601_fmt -- | UTC time in 'iso_8601_fmt'. -- -- > tm <- fmap (utctime_to_iso_8601 . T.posixSecondsToUTCTime) T.getPOSIXTime -- > (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4]) == (37,37,37) utctime_to_iso_8601 :: T.UTCTime -> String utctime_to_iso_8601 = T.formatTime T.defaultTimeLocale iso_8601_fmt -- | ISO 8601 of 'Time'. -- -- > tm <- fmap ntpr_to_iso_8601 time -- > import System.Process {- process -} -- > rawSystem "date" ["-d",tm] -- -- > t = 15708783354150518784 -- > s = "2015-11-26T00:22:19,366058349609+0000" -- > ntpr_to_iso_8601 (ntpi_to_ntpr t) == s ntpr_to_iso_8601 :: Time -> String ntpr_to_iso_8601 = utctime_to_iso_8601 . T.posixSecondsToUTCTime . ntpr_to_posixtime -- | 'Time' of ISO 8601. -- -- > t = 15708783354150518784 -- > s = "2015-11-26T00:22:19,366058349609+0000" -- > fmap ntpr_to_ntpi (iso_8601_to_ntpr s) == Just t iso_8601_to_ntpr :: String -> Maybe Time iso_8601_to_ntpr = fmap (posixtime_to_ntpr . T.utcTimeToPOSIXSeconds) . iso_8601_to_utctime -- | Alias for 'ntpr_to_iso_8601'. -- -- > time_pp immediately == "1900-01-01T00:00:00,000000000000+0000" -- > fmap time_pp time time_pp :: Time -> String time_pp = ntpr_to_iso_8601 hosc-0.17/Sound/OSC/Transport/0000755000000000000000000000000013406330137014273 5ustar0000000000000000hosc-0.17/Sound/OSC/Transport/Monad.hs0000644000000000000000000001035113406330137015665 0ustar0000000000000000-- | Monad class implementing an Open Sound Control transport. module Sound.OSC.Transport.Monad where import Control.Monad {- base -} import Data.List {- base -} import Data.Maybe {- base -} import qualified Control.Monad.Trans.Reader as R {- transformers -} import qualified Control.Monad.IO.Class as M {- transformers -} import qualified Sound.OSC.Datum as Datum {- hosc -} import qualified Sound.OSC.Transport.FD as FD {- hosc -} import qualified Sound.OSC.Packet as Packet {- hosc -} import qualified Sound.OSC.Wait as Wait {- hosc -} -- | Sender monad. class Monad m => SendOSC m where -- | Encode and send an OSC packet. sendPacket :: Packet.Packet -> m () -- | Receiver monad. class Monad m => RecvOSC m where -- | Receive and decode an OSC packet. recvPacket :: m Packet.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,M.MonadIO m) => Transport m where -- | 'SendOSC' over 'ReaderT'. instance (FD.Transport t,M.MonadIO io) => SendOSC (R.ReaderT t io) where sendPacket p = R.ReaderT (M.liftIO . flip FD.sendPacket p) -- | 'RecvOSC' over 'ReaderT'. instance (FD.Transport t,M.MonadIO io) => RecvOSC (R.ReaderT t io) where recvPacket = R.ReaderT (M.liftIO . FD.recvPacket) -- | 'DuplexOSC' over 'ReaderT'. instance (FD.Transport t,M.MonadIO io) => DuplexOSC (R.ReaderT t io) where -- | 'Transport' over 'ReaderT'. instance (FD.Transport t,M.MonadIO io) => Transport (R.ReaderT t io) where -- | Transport connection. type Connection t a = R.ReaderT t IO a -- | Bracket Open Sound Control communication. withTransport :: FD.Transport t => IO t -> Connection t a -> IO a withTransport u = FD.withTransport u . R.runReaderT -- * Send -- | Type restricted synonym for 'sendOSC'. sendMessage :: SendOSC m => Packet.Message -> m () sendMessage = sendPacket . Packet.Packet_Message -- | Type restricted synonym for 'sendOSC'. sendBundle :: SendOSC m => Packet.Bundle -> m () sendBundle = sendPacket . Packet.Packet_Bundle -- * Receive -- | Variant of 'recvPacket' that runs 'packet_to_bundle'. recvBundle :: (RecvOSC m) => m Packet.Bundle recvBundle = liftM Packet.packet_to_bundle recvPacket -- | Variant of 'recvPacket' that runs 'packet_to_message'. recvMessage :: (RecvOSC m) => m (Maybe Packet.Message) recvMessage = liftM Packet.packet_to_message recvPacket -- | Erroring variant. recvMessage_err :: RecvOSC m => m Packet.Message recvMessage_err = fmap (fromMaybe (error "recvMessage")) recvMessage -- | Variant of 'recvPacket' that runs 'packetMessages'. recvMessages :: (RecvOSC m) => m [Packet.Message] recvMessages = liftM Packet.packetMessages recvPacket -- * Wait -- | Wait for a 'Packet' where the supplied predicate is 'True', -- discarding intervening packets. waitUntil :: (RecvOSC m) => (Packet.Packet -> Bool) -> m Packet.Packet waitUntil f = Wait.untilPredicate f recvPacket -- | Wait for a 'Packet' where the supplied function does not give -- 'Nothing', discarding intervening packets. waitFor :: (RecvOSC m) => (Packet.Packet -> Maybe a) -> m a waitFor f = Wait.untilMaybe f recvPacket -- | 'waitUntil' 'packet_is_immediate'. waitImmediate :: RecvOSC m => m Packet.Packet waitImmediate = waitUntil Packet.packet_is_immediate -- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or -- immediate mode 'Bundle' with one element. waitMessage :: RecvOSC m => m Packet.Message waitMessage = waitFor Packet.packet_to_message -- | A 'waitFor' for variant using 'packet_has_address' to match on -- the 'Address_Pattern' of incoming 'Packets'. waitAddress :: RecvOSC m => Packet.Address_Pattern -> m Packet.Packet waitAddress s = let f o = if Packet.packet_has_address s o then Just o else Nothing in waitFor f -- | Variant on 'waitAddress' that returns matching 'Message'. waitReply :: RecvOSC m => Packet.Address_Pattern -> m Packet.Message waitReply s = let f = fromMaybe (error "waitReply: message not located?") . find (Packet.message_has_address s) . Packet.packetMessages in liftM f (waitAddress s) -- | Variant of 'waitReply' that runs 'messageDatum'. waitDatum :: RecvOSC m => Packet.Address_Pattern -> m [Datum.Datum] waitDatum = liftM Packet.messageDatum . waitReply hosc-0.17/Sound/OSC/Transport/FD.hs0000644000000000000000000000633313406330137015125 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.Datum {- hosc -} import Sound.OSC.Packet {- hosc -} import qualified Sound.OSC.Wait as Wait {- hosc -} -- | Abstract over the underlying transport protocol. class Transport t where -- | Encode and send an OSC packet. sendPacket :: t -> Packet -> 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 -- | 'sendPacket' of 'Packet_Message'. sendMessage :: Transport t => t -> Message -> IO () sendMessage t = sendPacket t . Packet_Message -- | 'sendPacket' of 'Packet_Bundle'. sendBundle :: Transport t => t -> Bundle -> IO () sendBundle t = sendPacket t . Packet_Bundle -- * Receive -- | 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 = Wait.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 = Wait.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 = Wait.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.17/Sound/OSC/Transport/FD/0000755000000000000000000000000013406330137014564 5ustar0000000000000000hosc-0.17/Sound/OSC/Transport/FD/UDP.hs0000644000000000000000000000633413406330137015556 0ustar0000000000000000-- | OSC over UDP implementation. module Sound.OSC.Transport.FD.UDP where import Control.Exception {- base -} import Control.Monad {- base -} import Data.Bifunctor {- base -} import qualified Network.Socket as N {- network -} import qualified Network.Socket.ByteString as C {- network -} import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -} import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -} import qualified Sound.OSC.Packet as Packet {- hosc -} import qualified Sound.OSC.Transport.FD as FD {- hosc -} -- | 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 = fmap fromIntegral . N.socketPort . udpSocket -- | Send packet over UDP. upd_send_packet :: UDP -> Packet.Packet -> IO () upd_send_packet (UDP fd) p = void (C.send fd (Builder.encodePacket_strict p)) -- | Receive packet over UDP. udp_recv_packet :: UDP -> IO Packet.Packet udp_recv_packet (UDP fd) = liftM Binary.decodePacket_strict (C.recv fd 8192) -- | Close UDP. udp_close :: UDP -> IO () udp_close (UDP fd) = N.close fd -- | 'UDP' is an instance of 'FD.Transport'. instance FD.Transport UDP where sendPacket = upd_send_packet recvPacket = udp_recv_packet close = udp_close -- | Bracket UDP communication. with_udp :: IO UDP -> (UDP -> IO t) -> IO t with_udp u = bracket u udp_close -- | 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 i:_ <- N.getAddrInfo Nothing (Just host) (Just (show port)) let sa = N.addrAddress i f fd sa return (UDP fd) -- | Set option, ie. 'N.Broadcast' or 'N.RecvTimeOut'. set_udp_opt :: N.SocketOption -> Int -> UDP -> IO () set_udp_opt k v (UDP s) = N.setSocketOption s k v -- | Get option. get_udp_opt :: N.SocketOption -> UDP -> IO Int get_udp_opt k (UDP s) = N.getSocketOption s k -- | Make a 'UDP' connection. openUDP :: String -> Int -> IO UDP openUDP = udp_socket N.connect {- | Trivial 'UDP' server socket. > import Control.Concurrent {- base -} > let t0 = udpServer "127.0.0.1" 57300 > forkIO (FD.withTransport t0 (\fd -> forever (FD.recvMessage fd >>= print))) > let t1 = openUDP "127.0.0.1" 57300 > FD.withTransport t1 (\fd -> FD.sendMessage fd (Packet.message "/n" [])) -} udpServer :: String -> Int -> IO UDP udpServer = udp_socket N.bind -- | Variant of 'udpServer' that doesn't require the host address. udp_server :: Int -> IO UDP udp_server p = do let hints = N.defaultHints {N.addrFlags = [N.AI_PASSIVE,N.AI_NUMERICSERV] ,N.addrSocketType = N.Datagram} a:_ <- N.getAddrInfo (Just hints) Nothing (Just (show p)) s <- N.socket (N.addrFamily a) (N.addrSocketType a) (N.addrProtocol a) N.setSocketOption s N.ReuseAddr 1 N.bind s (N.addrAddress a) return (UDP s) -- | Send variant to send to specified address. sendTo :: UDP -> Packet.Packet -> N.SockAddr -> IO () sendTo (UDP fd) p = void . C.sendTo fd (Builder.encodePacket_strict p) -- | Recv variant to collect message source address. recvFrom :: UDP -> IO (Packet.Packet, N.SockAddr) recvFrom (UDP fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192) hosc-0.17/Sound/OSC/Transport/FD/TCP.hs0000644000000000000000000000562313406330137015554 0ustar0000000000000000-- | OSC over TCP implementation. module Sound.OSC.Transport.FD.TCP where import qualified Control.Exception as Exception {- base -} import qualified Data.ByteString.Lazy as B {- bytestring -} import qualified Network.Socket as N {- network -} import qualified System.IO as IO {- base -} import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -} import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -} import qualified Sound.OSC.Coding.Byte as Byte {- hosc -} import qualified Sound.OSC.Packet as Packet {- hosc -} import qualified Sound.OSC.Transport.FD as FD {- hosc -} -- | The TCP transport handle data type. data TCP = TCP {tcpHandle :: IO.Handle} -- | Send packet over TCP. tcp_send_packet :: TCP -> Packet.Packet -> IO () tcp_send_packet (TCP fd) p = do let b = Builder.encodePacket p n = fromIntegral (B.length b) B.hPut fd (B.append (Byte.encode_u32 n) b) IO.hFlush fd -- | Receive packet over TCP. tcp_recv_packet :: TCP -> IO Packet.Packet tcp_recv_packet (TCP fd) = do b0 <- B.hGet fd 4 b1 <- B.hGet fd (fromIntegral (Byte.decode_u32 b0)) return (Binary.decodePacket b1) -- | Close TCP. tcp_close :: TCP -> IO () tcp_close = IO.hClose . tcpHandle -- | 'TCP' is an instance of 'Transport'. instance FD.Transport TCP where sendPacket = tcp_send_packet recvPacket = tcp_recv_packet close = tcp_close -- | Bracket UDP communication. with_tcp :: IO TCP -> (TCP -> IO t) -> IO t with_tcp u = Exception.bracket u tcp_close -- | Create and initialise TCP socket. tcp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> Maybe String -> Int -> IO N.Socket tcp_socket f host port = do fd <- N.socket N.AF_INET N.Stream 0 i:_ <- N.getAddrInfo Nothing host (Just (show port)) let sa = N.addrAddress i _ <- f fd sa return fd -- | Convert 'N.Socket' to 'TCP'. socket_to_tcp :: N.Socket -> IO TCP socket_to_tcp fd = fmap TCP (N.socketToHandle fd IO.ReadWriteMode) -- | Create and initialise TCP. tcp_handle :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO TCP tcp_handle f host port = tcp_socket f (Just host) port >>= socket_to_tcp {- | Make a 'TCP' connection. > import Sound.OSC.Datum {- hosc -} > import Sound.OSC.Time {- hosc -} > let t = openTCP "127.0.0.1" 57110 > let m1 = Packet.message "/dumpOSC" [Int32 1] > let m2 = Packet.message "/g_new" [Int32 1] > FD.withTransport t (\fd -> let f = FD.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2) -} openTCP :: String -> Int -> IO TCP openTCP = tcp_handle N.connect -- | 'N.accept' connection at /s/ and run /f/. tcp_server_f :: N.Socket -> (TCP -> IO ()) -> IO () tcp_server_f s f = do (fd, _) <- N.accept s h <- socket_to_tcp fd f h -- | 'sequence_' of 'repeat'. repeatM_ :: (Monad m) => m a -> m () repeatM_ = sequence_ . repeat -- | A trivial 'TCP' /OSC/ server. tcp_server :: Int -> (TCP -> IO ()) -> IO () tcp_server port f = do s <- tcp_socket N.bind Nothing port N.listen s 1 repeatM_ (tcp_server_f s f) hosc-0.17/Sound/OSC/Coding/0000755000000000000000000000000013406330137013502 5ustar0000000000000000hosc-0.17/Sound/OSC/Coding/Convert.hs0000644000000000000000000000236013406330137015457 0ustar0000000000000000-- | Type conversion. module Sound.OSC.Coding.Convert where import Data.Int {- base -} import Data.Word {- base -} -- | Type specialised 'fromIntegral' int_to_word8 :: Int -> Word8 int_to_word8 = fromIntegral -- | Type specialised 'fromIntegral' int_to_word32 :: Int -> Word32 int_to_word32 = fromIntegral -- | Type specialised 'fromIntegral'. int_to_word16 :: Int -> Word16 int_to_word16 = fromIntegral -- | Type specialised 'fromIntegral' int_to_int8 :: Int -> Int8 int_to_int8 = fromIntegral -- | Type specialised 'fromIntegral' int_to_int16 :: Int -> Int16 int_to_int16 = fromIntegral -- | Type specialised 'fromIntegral' int_to_int32 :: Int -> Int32 int_to_int32 = fromIntegral -- | Type specialised 'fromIntegral' int8_to_int :: Int8 -> Int int8_to_int = fromIntegral -- | Type specialised 'fromIntegral' int16_to_int :: Int16 -> Int int16_to_int = fromIntegral -- | Type specialised 'fromIntegral' int32_to_int :: Int32 -> Int int32_to_int = fromIntegral -- | Type specialised 'fromIntegral' word8_to_int :: Word8 -> Int word8_to_int = fromIntegral -- | Type specialised 'fromIntegral' word16_to_int :: Word16 -> Int word16_to_int = fromIntegral -- | Type specialised 'fromIntegral' word32_to_int :: Word32 -> Int word32_to_int = fromIntegral hosc-0.17/Sound/OSC/Coding/Cast.hs0000644000000000000000000000216013406330137014727 0ustar0000000000000000-- | Bit-level type casts and byte layout string typecasts. module Sound.OSC.Coding.Cast where import Data.Char {- base -} import Data.Word {- base -} import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -} -- | 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.17/Sound/OSC/Coding/Byte.hs0000644000000000000000000001621413406330137014745 0ustar0000000000000000-- | Byte-level coding utility functions. -- Plain forms are big-endian, little-endian forms have @_le@ suffix. module Sound.OSC.Coding.Byte where import Data.Bits {- base -} import Data.Int {- base -} import Data.Word {- base -} import System.IO {- base -} import qualified Data.Binary as Binary {- binary -} import qualified Data.Binary.Get as Get {- binary -} import qualified Data.Binary.Put as Put {- binary -} 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 qualified Sound.OSC.Coding.Cast as Cast {- hosc -} import Sound.OSC.Coding.Convert {- hosc -} -- * Encode -- | Encode a signed 8-bit integer. encode_i8 :: Int -> L.ByteString encode_i8 = Binary.encode . int_to_int8 -- | Encode an un-signed 8-bit integer. encode_u8 :: Int -> L.ByteString encode_u8 = Binary.encode . int_to_word8 -- | Type specialised 'Binary.encode'. -- -- > encode_w16 0x0102 == L.pack [1,2] encode_w16 :: Word16 -> L.ByteString encode_w16 = Binary.encode -- | Little-endian. -- -- > encode_w16_le 0x0102 == L.pack [2,1] encode_w16_le :: Word16 -> L.ByteString encode_w16_le = Put.runPut . Put.putWord16le -- | Encode an un-signed 16-bit integer. -- -- > encode_u16 0x0102 == L.pack [1,2] encode_u16 :: Int -> L.ByteString encode_u16 = encode_w16 . int_to_word16 -- | Little-endian. -- -- > encode_u16_le 0x0102 == L.pack [2,1] encode_u16_le :: Int -> L.ByteString encode_u16_le = encode_w16_le . int_to_word16 -- | Encode a signed 16-bit integer. encode_i16 :: Int -> L.ByteString encode_i16 = Binary.encode . int_to_int16 -- | Encode a signed 32-bit integer. encode_i32 :: Int -> L.ByteString encode_i32 = Binary.encode . int_to_int32 -- | Type specialised 'Binary.encode'. encode_w32 :: Word32 -> L.ByteString encode_w32 = Binary.encode -- | Encode an unsigned 32-bit integer. -- -- > encode_u32 0x01020304 == L.pack [1,2,3,4] encode_u32 :: Int -> L.ByteString encode_u32 = encode_w32 . int_to_word32 -- | Little-endian variant of 'encode_w32'. encode_w32_le :: Word32 -> L.ByteString encode_w32_le = Put.runPut . Put.putWord32le -- | Little-endian. -- -- > encode_u32_le 0x01020304 == L.pack [4,3,2,1] encode_u32_le :: Int -> L.ByteString encode_u32_le = encode_w32_le . int_to_word32 -- | Encode a signed 64-bit integer. encode_i64 :: Int64 -> L.ByteString encode_i64 = Binary.encode -- | Encode an unsigned 64-bit integer. encode_u64 :: Word64 -> L.ByteString encode_u64 = Binary.encode -- | Encode a 32-bit IEEE floating point number. encode_f32 :: Float -> L.ByteString encode_f32 = Binary.encode . Cast.f32_w32 -- | Little-endian variant of 'encode_f32'. encode_f32_le :: Float -> L.ByteString encode_f32_le = Put.runPut . Put.putWord32le . Cast.f32_w32 -- | Encode a 64-bit IEEE floating point number. encode_f64 :: Double -> L.ByteString encode_f64 = Binary.encode . Cast.f64_w64 -- | Encode an ASCII string (ASCII at Datum is an alias for a Char8 Bytetring). encode_str :: S.C.ByteString -> L.ByteString {-# INLINE encode_str #-} encode_str = L.pack . S.unpack -- * Decode -- | Decode an un-signed 8-bit integer. decode_u8 :: L.ByteString -> Int decode_u8 = word8_to_int . L.head -- | Decode a signed 8-bit integer. decode_i8 :: L.ByteString -> Int decode_i8 = int8_to_int . Binary.decode -- | Type specialised 'Binary.decode'. decode_word16 :: L.ByteString -> Word16 decode_word16 = Binary.decode -- | Decode an unsigned 8-bit integer. decode_u16 :: L.ByteString -> Int decode_u16 = word16_to_int . decode_word16 -- | Little-endian variant of 'decode_word16'. decode_word16_le :: L.ByteString -> Word16 decode_word16_le = Get.runGet Get.getWord16le -- | Little-endian variant of 'decode_u16'. decode_u16_le :: L.ByteString -> Int decode_u16_le = word16_to_int . decode_word16_le -- | Type specialised 'Binary.decode'. decode_int16 :: L.ByteString -> Int16 decode_int16 = Binary.decode -- | Decode a signed 16-bit integer. decode_i16 :: L.ByteString -> Int decode_i16 = int16_to_int . decode_int16 -- | Little-endian variant of 'decode_i16'. decode_i16_le :: L.ByteString -> Int decode_i16_le = decode_i16 . L.reverse -- | Decode a signed 32-bit integer. decode_i32 :: L.ByteString -> Int decode_i32 = int32_to_int . Binary.decode -- | Type specialised 'Binary.decode'. decode_word32 :: L.ByteString -> Word32 decode_word32 = Binary.decode -- | Decode an unsigned 32-bit integer. -- -- > decode_u32 (L.pack [1,2,3,4]) == 0x01020304 decode_u32 :: L.ByteString -> Int decode_u32 = word32_to_int . decode_word32 -- | Little-endian variant of 'decode_word32'. decode_word32_le :: L.ByteString -> Word32 decode_word32_le = Get.runGet Get.getWord32le -- | Little-endian variant of decode_u32. -- -- > decode_u32_le (L.pack [1,2,3,4]) == 0x04030201 decode_u32_le :: L.ByteString -> Int decode_u32_le = word32_to_int . decode_word32_le -- | Type specialised 'Binary.decode'. decode_i64 :: L.ByteString -> Int64 decode_i64 = Binary.decode -- | Type specialised 'Binary.decode'. decode_u64 :: L.ByteString -> Word64 decode_u64 = Binary.decode -- | Decode a 32-bit IEEE floating point number. decode_f32 :: L.ByteString -> Float decode_f32 = Cast.w32_f32 . decode_word32 -- | Little-endian variant of 'decode_f32'. decode_f32_le :: L.ByteString -> Float decode_f32_le = Cast.w32_f32 . decode_word32_le -- | Decode a 64-bit IEEE floating point number. decode_f64 :: L.ByteString -> Double decode_f64 b = Cast.w64_f64 (Binary.decode b :: Word64) -- | Decode an ASCII string, inverse of 'encode_str'. decode_str :: L.ByteString -> S.C.ByteString {-# INLINE decode_str #-} decode_str = S.C.pack . L.C.unpack -- * IO -- | 'decode_i8' of 'L.hGet'. read_i8 :: Handle -> IO Int read_i8 = fmap decode_i8 . flip L.hGet 1 -- | 'decode_i16' of 'L.hGet'. read_i16 :: Handle -> IO Int read_i16 = fmap decode_i16 . flip L.hGet 2 -- | 'decode_i32' of 'L.hGet'. read_i32 :: Handle -> IO Int read_i32 = fmap decode_i32 . flip L.hGet 4 -- | 'decode_u32' of 'L.hGet'. read_u32 :: Handle -> IO Int read_u32 = fmap decode_u32 . flip L.hGet 4 -- | 'decode_u32_le' of 'L.hGet'. read_u32_le :: Handle -> IO Int read_u32_le = fmap decode_u32_le . flip L.hGet 4 -- | 'decode_f32' of 'L.hGet'. read_f32 :: Handle -> IO Float read_f32 = fmap decode_f32 . flip L.hGet 4 -- | Read u8 length prefixed ASCII string (pascal string). read_pstr :: Handle -> IO S.C.ByteString read_pstr h = do n <- fmap decode_u8 (L.hGet h 1) fmap decode_str (L.hGet h n) -- | 'L.hPut' of 'encode_u32'. write_u32 :: Handle -> Int -> IO () write_u32 h = L.hPut h . encode_u32 -- | 'L.hPut' of 'encode_u32_le'. write_u32_le :: Handle -> Int -> IO () write_u32_le h = L.hPut h . encode_u32_le -- | 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.17/Sound/OSC/Coding/Decode/0000755000000000000000000000000013406330137014665 5ustar0000000000000000hosc-0.17/Sound/OSC/Coding/Decode/Binary.hs0000644000000000000000000001062413406330137016450 0ustar0000000000000000-- | Optimised decode function for OSC packets. module Sound.OSC.Coding.Decode.Binary (get_packet ,decodeMessage ,decodeBundle ,decodePacket ,decodePacket_strict) where import Control.Applicative {- base -} import Control.Monad {- 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 qualified Sound.OSC.Coding.Byte as Byte {- hosc -} import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -} import qualified Sound.OSC.Time as Time {- hosc -} -- | 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 (Byte.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 (Byte.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 (Byte.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 <$> Time.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', fail if type descriptor is invalid. 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 Byte.bundleHeader_strict) when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle") t <- Time.ntpi_to_ntpr <$> G.getWord64be ps <- get_message_seq return $ Bundle t ps -- | Get an OSC 'Packet'. get_packet :: G.Get Packet get_packet = (Packet_Bundle <$> get_bundle) <|> (Packet_Message <$> get_message) {-# INLINE decodeMessage #-} {-# INLINE decodeBundle #-} {-# INLINE decodePacket #-} {-# INLINE decodePacket_strict #-} -- | Decode an OSC 'Message' from a lazy ByteString. -- -- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -- > decodeMessage b == Message "/g_free" [Int32 0] decodeMessage :: B.ByteString -> Message decodeMessage = G.runGet get_message -- | Decode an OSC 'Bundle' from a lazy ByteString. decodeBundle :: B.ByteString -> Bundle decodeBundle = G.runGet get_bundle -- | Decode an OSC packet from a lazy ByteString. -- -- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -- > decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) decodePacket :: B.ByteString -> Packet decodePacket = G.runGet get_packet -- | Decode an OSC packet from a strict ByteString. decodePacket_strict :: S.C.ByteString -> Packet decodePacket_strict = G.runGet get_packet . B.fromChunks . (:[]) hosc-0.17/Sound/OSC/Coding/Decode/Base.hs0000644000000000000000000000725513406330137016104 0ustar0000000000000000-- | Base-level decode function for OSC packets. -- 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 {- hosc -} import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -} import Sound.OSC.Time {- hosc -} -- 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) -- * UTIL -- | 'B.take' with 'Int' count. b_take :: Int -> B.ByteString -> B.ByteString b_take = B.take . fromIntegral -- | 'B.drop' with 'Int' count. b_drop :: Int -> B.ByteString -> B.ByteString b_drop = B.drop . fromIntegral hosc-0.17/Sound/OSC/Coding/Encode/0000755000000000000000000000000013406330137014677 5ustar0000000000000000hosc-0.17/Sound/OSC/Coding/Encode/Base.hs0000644000000000000000000000351713406330137016113 0ustar0000000000000000-- | Base-level encode function for OSC packets (slow). -- For ordinary use see 'Sound.OSC.Coding.Encode.Builder'. module Sound.OSC.Coding.Encode.Base 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 {- hosc -} import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -} import Sound.OSC.Time {- hosc -} -- | Align byte string, if required. extend :: Word8 -> B.ByteString -> B.ByteString extend p s = B.append s (B.replicate (align (B.length s)) p) -- | Encode 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 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 OSC 'Message' as an OSC blob. encode_message_blob :: Message -> Datum encode_message_blob = Blob . encodeMessage -- | Encode 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 OSC 'Packet'. encodePacket :: Packet -> B.ByteString encodePacket o = case o of Packet_Message m -> encodeMessage m Packet_Bundle b -> encodeBundle b hosc-0.17/Sound/OSC/Coding/Encode/Builder.hs0000644000000000000000000000730513406330137016626 0ustar0000000000000000-- | Optimised encode function for OSC packets. module Sound.OSC.Coding.Encode.Builder (build_packet ,encodeMessage ,encodeBundle ,encodePacket ,encodePacket_strict) where import Data.Word {- base -} 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 qualified Sound.OSC.Coding.Byte as Byte {- hosc -} import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -} import Sound.OSC.Time {- hosc -} -- | Generate a list of zero bytes for padding. padding :: Integral i => i -> [Word8] padding n = replicate (fromIntegral n) 0 -- | Nul byte (0) and then zero padding. nul_and_padding :: Int -> B.Builder nul_and_padding n = B.fromWord8s (0 : padding (Byte.align n)) -- Encode a string with zero padding. build_ascii :: ASCII -> B.Builder build_ascii s = B.fromByteString s `mappend` nul_and_padding (S.length s + 1) -- Encode a string with zero padding. build_string :: String -> B.Builder build_string s = B.fromString s `mappend` nul_and_padding (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 (Byte.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 :: NTP64 -> [Message] -> B.Builder build_bundle_ntpi t l = mconcat [B.fromLazyByteString Byte.bundleHeader ,B.fromWord64be t ,mconcat (map (build_bytes . B.toLazyByteString . build_message) l)] -- | Builder 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 encodePacket #-} {-# INLINE encodeMessage #-} {-# INLINE encodeBundle #-} {-# INLINE encodePacket_strict #-} -- | Encode an OSC 'Packet'. encodePacket :: Packet -> L.ByteString encodePacket = B.toLazyByteString . build_packet {- | Encode an OSC 'Message', ie. 'encodePacket' of 'Packet_Message'. > let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] > encodeMessage (Message "/g_free" [Int32 0]) == L.pack m -} encodeMessage :: Message -> L.ByteString encodeMessage = encodePacket . Packet_Message {- | Encode an OSC 'Bundle', ie. 'encodePacket' of 'Packet_Bundle'. > let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] > let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m > encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b -} encodeBundle :: Bundle -> L.ByteString encodeBundle = encodePacket . Packet_Bundle -- | Encode an OSC 'Packet' to a strict 'S.ByteString'. encodePacket_strict :: Packet -> S.ByteString encodePacket_strict = B.toByteString . build_packet