hosc 0.8 → 0.21.1

raw patch · 40 files changed

Files

Help/timer.hs +0/−17
README +0/−14
README.md +39/−0
Setup.hs +3/−0
Setup.lhs +0/−3
Sound/OpenSoundControl.hs +0/−17
Sound/OpenSoundControl/Byte.hs +0/−80
Sound/OpenSoundControl/Cast.hs +0/−62
Sound/OpenSoundControl/Coerce.hs +0/−30
Sound/OpenSoundControl/OSC.hs +0/−161
Sound/OpenSoundControl/Time.hs +0/−79
Sound/OpenSoundControl/Transport.hs +0/−42
Sound/OpenSoundControl/Transport/TCP.hs +0/−38
Sound/OpenSoundControl/Transport/UDP.hs +0/−52
Sound/Osc.hs +7/−0
Sound/Osc/Coding/Byte.hs +410/−0
Sound/Osc/Coding/Cast.hs +72/−0
Sound/Osc/Coding/Convert.hs +129/−0
Sound/Osc/Coding/Decode/Base.hs +122/−0
Sound/Osc/Coding/Decode/Binary.hs +152/−0
Sound/Osc/Coding/Encode/Base.hs +117/−0
Sound/Osc/Coding/Encode/Builder.hs +115/−0
Sound/Osc/Core.hs +21/−0
Sound/Osc/Datum.hs +264/−0
Sound/Osc/Fd.hs +6/−0
Sound/Osc/Packet.hs +142/−0
Sound/Osc/Text.hs +279/−0
Sound/Osc/Time.hs +116/−0
Sound/Osc/Time/System.hs +25/−0
Sound/Osc/Time/Thread.hs +39/−0
Sound/Osc/Time/Thread/MonadIO.hs +25/−0
Sound/Osc/Time/Timeout.hs +15/−0
Sound/Osc/Transport/Fd.hs +101/−0
Sound/Osc/Transport/Fd/Socket.hs +40/−0
Sound/Osc/Transport/Fd/Tcp.hs +101/−0
Sound/Osc/Transport/Fd/Udp.hs +119/−0
Sound/Osc/Transport/Monad.hs +128/−0
Sound/Osc/Wait.hs +18/−0
contrib/LICENSE +674/−0
hosc.cabal +47/−30

− Help/timer.hs

@@ -1,17 +0,0 @@--- hosc does not directly support a timeout at recv, however the--- standard libraries have the 'System.Timeout.timeout' function that--- works for interupting socket reads.--import Sound.OpenSoundControl-import qualified System.Timeout as T--timeout :: Double -> IO a -> IO (Maybe a)-timeout t =-    let i = floor (t * 1000000)-    in T.timeout i--main :: IO ()-main = do-  fd <- openUDP "127.0.0.1" 57110-  r <- timeout 0.5 (recv fd)-  print r

− README

@@ -1,14 +0,0 @@-hosc - haskell open sound control--hosc provides Sound.OpenSoundControl, a haskell-module implementing a subset of the Open Sound-Control byte protocol.--  http://slavepianos.org/rd/?t=hosc-  http://haskell.org/-  http://opensoundcontrol.org/--(c) rohan drape and others, 2006-2010-    gpl, http://gnu.org/copyleft/-    with contributions by alex mclean-    see darcs history for details

+ README.md view

@@ -0,0 +1,39 @@+hosc - haskell open sound control+---------------------------------++[hosc][hosc] provides `Sound.Osc`, a [haskell][hs]+module implementing a subset of the [Open Sound Control][osc] byte protocol.+hosc is required by the [hsc3][hsc3] Haskell [SuperCollider][sc3] bindings.++See also:++- [hosc-json](http://rohandrape.net/?t=hosc-json): Json text encoding of Osc+- [hosc-util](http://rohandrape.net/?t=hosc-util): non-core Osc functions++© [Rohan Drape][rd], [Stefan Kersten][sk] and others, 2007-2024,+[Gpl-3][gpl-3]. with contributions by:++- [Alex McLean][am]+- [Henning Thielemann][ht]++Please see the [history](http://rohandrape.net/?t=hosc&q=history) for details++[hosc]: http://rohandrape.net/?t=hosc+[hs]: http://haskell.org/+[osc]: https://opensoundcontrol.stanford.edu/+[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/+[gpl-3]: http://gnu.org/licenses/gpl-3.0.html++* * *++```+$ make doctest+Examples: 110  Tried: 110  Errors: 0  Failures: 0+$+```

+ Setup.hs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

− Setup.lhs

@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain

− Sound/OpenSoundControl.hs

@@ -1,17 +0,0 @@--- | hosc implements a subset of the Open Sound Control byte protocol.---   The protocol is documented at <http://opensoundcontrol.org/>.-module Sound.OpenSoundControl (module Sound.OpenSoundControl.OSC,-                               module Sound.OpenSoundControl.Time,-                               module Sound.OpenSoundControl.Cast,-                               module Sound.OpenSoundControl.Byte,-                               module Sound.OpenSoundControl.Transport,-                               module Sound.OpenSoundControl.Transport.UDP,-                               module Sound.OpenSoundControl.Transport.TCP) where--import Sound.OpenSoundControl.OSC-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Cast-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Transport.UDP-import Sound.OpenSoundControl.Transport.TCP

− Sound/OpenSoundControl/Byte.hs

@@ -1,80 +0,0 @@--- | Byte-level encoding and decoding functions.-module Sound.OpenSoundControl.Byte where--import Data.Binary-import qualified Data.ByteString.Lazy as B-import Data.Char-import Data.Int-import Sound.OpenSoundControl.Cast---- | Encode a signed 8-bit integer.-encode_i8 :: Int -> B.ByteString-encode_i8 n = encode (fromIntegral n :: Int8)---- | Encode a signed 16-bit integer.-encode_i16 :: Int -> B.ByteString-encode_i16 n = encode (fromIntegral n :: Int16)---- | Encode a signed 32-bit integer.-encode_i32 :: Int -> B.ByteString-encode_i32 n = encode (fromIntegral n :: Int32)---- | Encode an unsigned 16-bit integer.-encode_u32 :: Int -> B.ByteString-encode_u32 n = encode (fromIntegral n :: Word32)---- | Encode a signed 64-bit integer.-encode_i64 :: Integer -> B.ByteString-encode_i64 n = encode (fromIntegral n :: Int64)---- | Encode an unsigned 64-bit integer.-encode_u64 :: Integer -> B.ByteString-encode_u64 n = encode (fromIntegral n :: Word64)---- | Encode a 32-bit IEEE floating point number.-encode_f32 :: Double -> B.ByteString-encode_f32 = encode . f32_i32 . realToFrac---- | Encode a 64-bit IEEE floating point number.-encode_f64 :: Double -> B.ByteString-encode_f64 = encode . f64_i64---- | Encode an ASCII string.-encode_str :: String -> B.ByteString-encode_str = B.pack . map (fromIntegral . ord)---- | Decode a signed 8-bit integer.-decode_i8 :: B.ByteString -> Int-decode_i8 b = fromIntegral (decode b :: Int8)---- | Decode a signed 16-bit integer.-decode_i16 :: B.ByteString -> Int-decode_i16 b = fromIntegral (decode b :: Int16)---- | Decode a signed 32-bit integer.-decode_i32 :: B.ByteString -> Int-decode_i32 b = fromIntegral (decode b :: Int32)---- | Decode an unsigned 32-bit integer.-decode_u32 :: B.ByteString -> Int-decode_u32 b = fromIntegral (decode b :: Word32)---- | Decode a signed 64-bit integer.-decode_i64 :: B.ByteString -> Integer-decode_i64 b = fromIntegral (decode b :: Int64)---- | Decode an unsigned 64-bit integer.-decode_u64 :: B.ByteString -> Integer-decode_u64 b = fromIntegral (decode b :: Word64)---- | Decode a 32-bit IEEE floating point number.-decode_f32 :: B.ByteString -> Double-decode_f32 b = realToFrac (i32_f32 (decode b :: Int32))---- | Decode a 64-bit IEEE floating point number.-decode_f64 :: B.ByteString -> Double-decode_f64 b = i64_f64 (decode b :: Int64)---- | Decode an ASCII string.-decode_str :: B.ByteString -> String-decode_str = map (chr . fromIntegral) . B.unpack

− Sound/OpenSoundControl/Cast.hs

@@ -1,62 +0,0 @@--- | Bit-level type casts and byte layout string typecasts.-module Sound.OpenSoundControl.Cast (f32_i32, i32_f32,-                                    f64_i64, i64_f64,-                                    str_cstr, cstr_str,-                                    str_pstr, pstr_str) where--import Control.Monad.ST-import Data.Array.ST-import Data.Char-import Data.Int-import Data.Word---- | The IEEE byte representation of a float packed into an integer.-f32_i32 :: Float -> Int32-f32_i32 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Int32)---- | Inverse of 'f32_i32'.-i32_f32 :: Int32 -> Float-i32_f32 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Float)---- | The IEEE byte representation of a double packed into an integer.-f64_i64 :: Double -> Int64-f64_i64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Int64)--{--http://www.haskell.org/pipermail/haskell-cafe/2008-February/040000.html--{-# LANGUAGE MagicHash #-}-import Data.Int-import GHC.Exts--f64_i64 :: Double -> Int64 --ghc only-f64_i64 (D# x) = I64# (unsafeCoerce# x)--}---- | Inverse of 'f64_i64'.-i64_f64 :: Int64 -> Double-i64_f64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Double)---- | 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---- One element marray.-unit_array :: (MArray a e m) => e -> m (a Int e)-unit_array = newArray (0, 0::Int)---- Extract first element from array.-from_array :: (MArray a e m) => a Int e -> m e-from_array = flip readArray 0

− Sound/OpenSoundControl/Coerce.hs

@@ -1,30 +0,0 @@--- | OSC packet coercion and normalization.-module Sound.OpenSoundControl.Coerce where--import Sound.OpenSoundControl.OSC---- | Map a normalizing function over datum at an osc packet.-coerce :: (Datum -> Datum) -> OSC -> OSC-coerce f (Message s xs) = Message s (map f xs)-coerce f (Bundle t xs) = Bundle t (map (coerce f) xs)---- | Coerce Float to Double.-f_to_d :: Datum -> Datum-f_to_d (Float n) = Double n-f_to_d x = x---- | Coerce Int and Float to Double.-if_to_d :: Datum -> Datum-if_to_d (Int n) = Double (fromIntegral n)-if_to_d (Float n) = Double n-if_to_d x = x---- | Coerce Float and Double to Int.-fd_to_i :: Datum -> Datum-fd_to_i (Float n) = Int (round n)-fd_to_i (Double n) = Int (round n)-fd_to_i x = x---- | A normalized osc packet has only Int and Double numerical values.-normalize :: OSC -> OSC-normalize = coerce f_to_d

− Sound/OpenSoundControl/OSC.hs

@@ -1,161 +0,0 @@--- | Alegbraic data types for OSC packets and encode and decode---   functions.-module Sound.OpenSoundControl.OSC ( OSC(..)-                                  , Datum(..)-                                  , encodeOSC-                                  , decodeOSC ) where--import qualified Data.ByteString.Lazy as B-import Data.List-import Data.Maybe-import Data.Word-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.Cast---- | The basic elements of OSC messages.-data Datum = Int Int-           | Float Double-           | Double Double-           | String String-           | Blob [Word8]-           | TimeStamp Time-             deriving (Eq, Show)---- | An OSC packet.-data OSC = Message String [Datum]-         | Bundle Time [OSC]-           deriving (Eq, Show)---- | OSC bundles can be ordered (time ascending).-instance Ord OSC where-    compare (Bundle a _) (Bundle b _) = compare a b-    compare _ _ = EQ---- OSC types have single character identifiers.-tag :: Datum -> Char-tag (Int _) = 'i'-tag (Float _) = 'f'-tag (Double _) = 'd'-tag (String _) = 's'-tag (Blob _) = 'b'-tag (TimeStamp _) = 't'---- Command argument types are given by a descriptor.-descriptor :: [Datum] -> Datum-descriptor l = String (',' : map tag l)---- The number of bytes required to align an OSC value.-align :: Int -> Int-align n = (-n) `mod` 4---- Align a byte string if required.-extend :: a -> [a] -> [a]-extend p s = s ++ replicate (align (length s)) p---- Encode an OSC datum.-encode_datum :: Datum -> B.ByteString-encode_datum (Int i) = encode_i32 i-encode_datum (Float f) = encode_f32 f-encode_datum (Double d) = encode_f64 d-encode_datum (TimeStamp t) = encode_u64 $ as_ntpi t-encode_datum (String s) = B.pack (extend 0 (str_cstr s))-encode_datum (Blob b) = B.concat [encode_i32 (length b), B.pack (extend 0 b)]---- Encode an OSC message.-encode_message :: String -> [Datum] -> B.ByteString-encode_message c l = -    B.concat [ encode_datum (String c)-             , encode_datum (descriptor l)-             , B.concat (map encode_datum l) ]---- Encode an OSC packet as an OSC blob.-encode_osc_blob :: OSC -> Datum-encode_osc_blob = Blob . B.unpack . encodeOSC---- Encode an OSC bundle.-encode_bundle_ntpi :: Integer -> [OSC] -> B.ByteString-encode_bundle_ntpi t l =-    B.concat [ bundle_header-             , encode_u64 t-             , B.concat (map (encode_datum . encode_osc_blob) l) ]---- | Encode an OSC packet.-encodeOSC :: OSC -> B.ByteString-encodeOSC (Message c l) = encode_message c l-encodeOSC (Bundle (NTPi t) l) = encode_bundle_ntpi t l-encodeOSC (Bundle (NTPr t) l) = encode_bundle_ntpi (ntpr_ntpi t) l-encodeOSC (Bundle (UTCr t) l) = encode_bundle_ntpi (utcr_ntpi t) l---- The plain byte count of an OSC value.-size :: Char -> B.ByteString -> Int-size 'i' _ = 4-size 'f' _ = 4-size 'd' _ = 8-size 't' _ = 8 -- timetag-size 's' b = fromIntegral (fromMaybe-                           (error ("size: no terminating zero: " ++ show b))-                           (B.elemIndex 0 b))-size 'b' b = decode_i32 (B.take 4 b)-size _ _ = error "size: illegal type"---- The storage byte count of an OSC value.-storage :: Char -> B.ByteString -> Int-storage 's' b = n + align n where n = size 's' b + 1-storage 'b' b = n + align n + 4 where n = size 'b' b-storage c _ = size c B.empty---- Decode an OSC datum-decode_datum :: Char -> B.ByteString -> Datum-decode_datum 'i' b = Int (decode_i32 b)-decode_datum 'f' b = Float (decode_f32 b)-decode_datum 'd' b = Double (decode_f64 b)-decode_datum 's' b = String (decode_str (b_take n b)) where n = size 's' b-decode_datum 'b' b = Blob (B.unpack (b_take n (B.drop 4 b))) where n = size 'b' b-decode_datum 't' b = TimeStamp $ NTPi (decode_u64 b)-decode_datum t _ = error ("decode_datum: illegal type (" ++ [t] ++ ")")---- Decode a sequence of OSC datum given a type descriptor string.-decode_datum_seq :: [Char] -> B.ByteString -> [Datum]-decode_datum_seq cs b = zipWith decode_datum cs (snd (mapAccumL f b cs))-    where swap (x,y) = (y,x)-          f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')---- Decode an OSC message.-decode_message :: B.ByteString -> OSC-decode_message b = Message cmd arg-    where n = storage 's' b-          (String cmd) = decode_datum 's' b-          m = storage 's' (b_drop n b)-          (String dsc) = decode_datum 's' (b_drop n b)-          arg = decode_datum_seq (drop 1 dsc) (b_drop (n + m) b)---- Decode a sequence of OSC messages, each one headed by its length-decode_message_seq :: B.ByteString -> [OSC]-decode_message_seq b | B.length b == 0 = []-                     | otherwise = m:nxt-                     where s = decode_i32 b-                           m = decode_message $ b_drop 4 b-                           nxt = decode_message_seq $ b_drop (4+s) b--decode_bundle :: B.ByteString -> OSC-decode_bundle b = Bundle timeStamp ms-    where 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---- | Decode an OSC packet.-decodeOSC :: B.ByteString -> OSC-decodeOSC b | bundle_header `B.isPrefixOf` b = decode_bundle b-            | otherwise = decode_message 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--bundle_header :: B.ByteString-bundle_header = encode_datum (String "#bundle")-

− Sound/OpenSoundControl/Time.hs

@@ -1,79 +0,0 @@--- | Temporal representations and clock operations (read current time---   and pause thread).-module Sound.OpenSoundControl.Time where--import Control.Concurrent-import Control.Monad-import qualified Data.Time as T---- | Time is represented in either UTC or NTP form.-data Time = UTCr Double | NTPr Double | NTPi Integer-            deriving (Eq, Show)---- | Coerce to NTPi form.-as_ntpi :: Time -> Integer-as_ntpi (UTCr t) = utcr_ntpi t-as_ntpi (NTPr t) = ntpr_ntpi t-as_ntpi (NTPi t) = t---- | Coerce to UTCr form.-as_utcr :: Time -> Double-as_utcr (UTCr t) = t-as_utcr (NTPr t) = ntpr_utcr t-as_utcr (NTPi t) = ntpi_utcr t---- | Times can be ordered, avoid coercion if not required.-instance Ord Time where-    compare (UTCr p) (UTCr q) = compare p q-    compare (NTPr p) (NTPr q) = compare p q-    compare (NTPi p) (NTPi q) = compare p q-    compare p q = compare (as_ntpi p) (as_ntpi q)---- | Convert a real-valued NTP timestamp to an NTP timestamp.-ntpr_ntpi :: Double -> Integer-ntpr_ntpi t = round (t * 2^(32::Int))---- | Convert an NTP timestamp to a real-valued NTP timestamp.-ntpi_ntpr :: Integer -> Double-ntpi_ntpr t = fromIntegral t / 2^(32::Int)---- | Convert UTC timestamp to NTP timestamp.-utcr_ntpi :: Double -> Integer-utcr_ntpi t = ntpr_ntpi (t + secdif)-    where secdif = (70 * 365 + 17) * 24 * 60 * 60---- | Convert NTP timestamp to UTC timestamp.-ntpr_utcr :: Double -> Double-ntpr_utcr t = t - secdif-    where secdif = (70 * 365 + 17) * 24 * 60 * 60---- | Convert NTP timestamp to UTC timestamp.-ntpi_utcr :: Integer -> Double-ntpi_utcr = ntpr_utcr . ntpi_ntpr---- | The time at 1970-01-01:00:00:00.-utc_base :: T.UTCTime-utc_base = T.UTCTime d s-    where d = T.fromGregorian 1970 1 1-          s = T.secondsToDiffTime 0---- | Read current UTCr timestamp.-utcr :: IO Double-utcr = do t <- T.getCurrentTime-          return (realToFrac (T.diffUTCTime t utc_base))---- | Read current NTP timestamp.-ntpi :: IO Integer-ntpi = liftM utcr_ntpi utcr---- | Pause current thread for the indicated duration, given in seconds.-pauseThread :: Double -> IO ()-pauseThread n = when (n > 1e-4) (threadDelay (floor (n * 1e6)))---- | Pause current thread until the given utcr time.-pauseThreadUntil :: Double -> IO ()-pauseThreadUntil t = pauseThread . (t -) =<< utcr---- | Execute the bundle immediately.-immediately :: Time-immediately = NTPi 1

− Sound/OpenSoundControl/Transport.hs

@@ -1,42 +0,0 @@--- | An abstract transport layer with implementations for UDP and TCP---   transport.-module Sound.OpenSoundControl.Transport ( Transport(..)-                                        , withTransport-                                        , waitFor, wait ) where--import Control.Exception-import Sound.OpenSoundControl.OSC---- | Abstract over the underlying transport protocol.-class Transport t where-   -- | Encode and send an OSC packet.-   send :: t -> OSC -> IO ()-   -- | Receive and decode an OSC packet.-   recv :: t -> IO OSC-   -- | Close an existing connection.-   close :: t -> IO ()---- Does the OSC message have the specified address.-has_address :: String -> OSC -> Bool-has_address x (Message y _) = x == y-has_address _ _ = False---- Repeat action until function does not give Nothing when applied to result.-untilM :: Monad m => (a -> Maybe b) -> m a -> m b-untilM f act = recurse-    where g p = let q = f p in case q of { Nothing -> recurse-                                         ; Just r -> return r }-          recurse = act >>= g---- | Wait for an OSC message where the supplied function does not give---   Nothing, discarding intervening messages.-waitFor :: Transport t => t -> (OSC -> Maybe a) -> IO a-waitFor t f = untilM f (recv t)---- | A 'waitFor' for variant matching on address string of messages.-wait :: Transport t => t -> String -> IO OSC-wait t s = waitFor t (\o -> if has_address s o then Just o else Nothing)---- | Bracket OSC communication.-withTransport :: Transport t => IO t -> (t -> IO a) -> IO a-withTransport u = bracket u close

− Sound/OpenSoundControl/Transport/TCP.hs

@@ -1,38 +0,0 @@--- | OSC over TCP implementation.-module Sound.OpenSoundControl.Transport.TCP (TCP, openTCP, tcpServer) where--import qualified Data.ByteString.Lazy as B-import Control.Monad-import Network-import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.OSC-import System.IO---- | The TCP transport handle data type.-data TCP = TCP Handle deriving (Eq, Show)--instance Transport TCP where-   send (TCP fd) msg =-      do let b = encodeOSC msg-             n = fromIntegral (B.length b)-         B.hPut fd (B.append (encode_u32 n) b)-         hFlush fd--   recv (TCP fd) =-      do b0 <- B.hGet fd 4-         b1 <- B.hGet fd (fromIntegral (decode_u32 b0))-         return (decodeOSC 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 ())

− Sound/OpenSoundControl/Transport/UDP.hs

@@ -1,52 +0,0 @@--- | OSC over UDP implementation.-module Sound.OpenSoundControl.Transport.UDP ( UDP(udpSocket)-                                            , openUDP-                                            , udpServer-                                            , udpPort-                                            , sendTo, recvFrom ) where--import Control.Monad-import qualified Network.Socket as N-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.OSC-import Sound.OpenSoundControl.Transport---- | The UDP transport handle data type.-data UDP = UDP { udpSocket :: N.Socket }-           deriving (Eq, Show)--instance Transport UDP where-   send  (UDP fd) msg = N.send fd (decode_str (encodeOSC msg)) >> return ()-   recv  (UDP fd) = liftM (decodeOSC . encode_str) (N.recv fd 8192)-   close (UDP fd) = N.sClose fd---- | Make a UDP connection.-openUDP :: String -> Int -> IO UDP-openUDP host port = do fd <- N.socket N.AF_INET N.Datagram 0-                       a  <- N.inet_addr host-                       let sa = N.SockAddrInet (fromIntegral port) a-                       N.connect fd sa-                       -- N.setSocketOption fd N.RecvTimeOut 1000-                       return (UDP fd)---- | Trivial udp server.-udpServer :: String -> Int -> IO UDP-udpServer host port = do fd <- N.socket N.AF_INET N.Datagram 0-                         a  <- N.inet_addr host-                         let sa = N.SockAddrInet (fromIntegral port) a-                         N.bindSocket fd sa-                         return (UDP fd)--sendTo :: UDP -> OSC -> N.SockAddr -> IO ()-sendTo (UDP fd) o a =-    do N.sendTo fd (decode_str (encodeOSC o)) a-       return ()--recvFrom :: UDP -> IO (OSC, N.SockAddr)-recvFrom (UDP fd) = -    do (s, _, a) <- N.recvFrom fd 8192-       let o = (decodeOSC . encode_str) s-       return (o, a)--udpPort :: Integral n => UDP -> IO n-udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)

+ Sound/Osc.hs view

@@ -0,0 +1,7 @@+-- | 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.Socket as M+import Sound.Osc.Transport.Monad as M

+ Sound/Osc/Coding/Byte.hs view

@@ -0,0 +1,410 @@+{- | 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 GHC.ByteOrder {- base -}++import qualified Data.Binary as Binary {- binary -}+import qualified Data.Binary.Get as Binary.Get {- binary -}+import qualified Data.Binary.Put as Binary.Put {- binary -}++import qualified Data.ByteString as ByteString {- bytestring -}+import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Internal as ByteString.Internal {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}+import qualified Data.ByteString.Unsafe as ByteString.Unsafe {- bytestring -}++import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}++-- * Encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_int8 :: Int8 -> ByteString.Lazy.ByteString+encode_int8 = Binary.encode++{- | Type specialised 'Binary.encode' (big-endian).++>>> encode_int16 0x0102 == ByteString.Lazy.pack [0x01,0x02]+True+-}+encode_int16 :: Int16 -> ByteString.Lazy.ByteString+encode_int16 = Binary.encode++{- | Little-endian.++>>> encode_int16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01]+True+-}+encode_int16_le :: Int16 -> ByteString.Lazy.ByteString+encode_int16_le = Binary.Put.runPut . Binary.Put.putInt16le++-- | Encode a signed 64-bit integer (big-endian).+encode_int64 :: Int64 -> ByteString.Lazy.ByteString+encode_int64 = Binary.encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_word8 :: Word8 -> ByteString.Lazy.ByteString+encode_word8 = Binary.encode++{- | Type specialised 'Binary.encode' (big-endian).++>>> encode_word16 0x0102 == ByteString.Lazy.pack [0x01,0x02]+True+-}+encode_word16 :: Word16 -> ByteString.Lazy.ByteString+encode_word16 = Binary.encode++{- | Little-endian.++>>> encode_word16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01]+True+-}+encode_word16_le :: Word16 -> ByteString.Lazy.ByteString+encode_word16_le = Binary.Put.runPut . Binary.Put.putWord16le++-- | Type specialised 'Binary.encode'.+encode_word32 :: Word32 -> ByteString.Lazy.ByteString+encode_word32 = Binary.encode++-- | Little-endian variant of 'encode_word32'.+encode_word32_le :: Word32 -> ByteString.Lazy.ByteString+encode_word32_le = Binary.Put.runPut . Binary.Put.putWord32le++-- | Encode an unsigned 64-bit integer.+encode_word64 :: Word64 -> ByteString.Lazy.ByteString+encode_word64 = Binary.encode++-- * Encode/Int++-- | Encode a signed 8-bit integer.+encode_i8 :: Int -> ByteString.Lazy.ByteString+encode_i8 = encode_int8 . Convert.int_to_int8++-- | Encode an un-signed 8-bit integer.+encode_u8 :: Int -> ByteString.Lazy.ByteString+encode_u8 = encode_word8 . Convert.int_to_word8++{- | Encode an un-signed 16-bit integer.++>>> encode_u16 0x0102 == ByteString.Lazy.pack [1,2]+True+-}+encode_u16 :: Int -> ByteString.Lazy.ByteString+encode_u16 = encode_word16 . Convert.int_to_word16++{- | Little-endian.++>>> encode_u16_le 0x0102 == ByteString.Lazy.pack [2,1]+True+-}+encode_u16_le :: Int -> ByteString.Lazy.ByteString+encode_u16_le = encode_word16_le . Convert.int_to_word16++-- | Encode a signed 16-bit integer.+encode_i16 :: Int -> ByteString.Lazy.ByteString+encode_i16 = Binary.encode . Convert.int_to_int16++-- | Encode a signed 32-bit integer.+encode_i32 :: Int -> ByteString.Lazy.ByteString+encode_i32 = Binary.encode . Convert.int_to_int32++{- | Encode an unsigned 32-bit integer.++>>> ByteString.Lazy.unpack (encode_u32 0x01020304)+[1,2,3,4]+-}+encode_u32 :: Int -> ByteString.Lazy.ByteString+encode_u32 = encode_word32 . Convert.int_to_word32++{- | Little-endian.++>>> ByteString.Lazy.unpack (encode_u32_le 0x01020304)+[4,3,2,1]+-}+encode_u32_le :: Int -> ByteString.Lazy.ByteString+encode_u32_le = encode_word32_le . Convert.int_to_word32++-- * Encode/Float++{- | Encode a 32-bit IEEE floating point number.++>>> ByteString.Lazy.unpack (encode_f32 3.141)+[64,73,6,37]+-}+encode_f32 :: Float -> ByteString.Lazy.ByteString+encode_f32 = Binary.Put.runPut . Binary.Put.putFloatbe++{- | Little-endian variant of 'encode_f32'.++>>> ByteString.Lazy.unpack (encode_f32_le 3.141)+[37,6,73,64]+-}+encode_f32_le :: Float -> ByteString.Lazy.ByteString+encode_f32_le = Binary.Put.runPut . Binary.Put.putFloatle++{- | Encode a 64-bit IEEE floating point number.++>>> ByteString.Lazy.unpack (encode_f64 3.141)+[64,9,32,196,155,165,227,84]+-}+encode_f64 :: Double -> ByteString.Lazy.ByteString+encode_f64 = Binary.Put.runPut . Binary.Put.putDoublebe++{- | Little-endian variant of 'encode_f64'.++>>> ByteString.Lazy.unpack (encode_f64_le 3.141)+[84,227,165,155,196,32,9,64]+-}+encode_f64_le :: Double -> ByteString.Lazy.ByteString+encode_f64_le = Binary.Put.runPut . Binary.Put.putDoublele++-- * Encode/Ascii++-- | Encode an Ascii string (Ascii at Datum is an alias for a Char8 Bytetring).+encode_ascii :: ByteString.Char8.ByteString -> ByteString.Lazy.ByteString+encode_ascii = ByteString.Lazy.pack . ByteString.unpack++-- * Decode++-- | Type specialised 'Binary.decode'.+decode_word16 :: ByteString.Lazy.ByteString -> Word16+decode_word16 = Binary.decode++-- | Little-endian variant of 'decode_word16'.+decode_word16_le :: ByteString.Lazy.ByteString -> Word16+decode_word16_le = Binary.Get.runGet Binary.Get.getWord16le++-- | Type specialised 'Binary.decode'.+decode_int16 :: ByteString.Lazy.ByteString -> Int16+decode_int16 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word32 :: ByteString.Lazy.ByteString -> Word32+decode_word32 = Binary.decode++-- | Little-endian variant of 'decode_word32'.+decode_word32_le :: ByteString.Lazy.ByteString -> Word32+decode_word32_le = Binary.Get.runGet Binary.Get.getWord32le++-- | Type specialised 'Binary.decode'.+decode_int64 :: ByteString.Lazy.ByteString -> Int64+decode_int64 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word64 :: ByteString.Lazy.ByteString -> Word64+decode_word64 = Binary.decode++-- * Decode/Int++-- | Decode an un-signed 8-bit integer.+decode_u8 :: ByteString.Lazy.ByteString -> Int+decode_u8 = Convert.word8_to_int . ByteString.Lazy.head++-- | Decode a signed 8-bit integer.+decode_i8 :: ByteString.Lazy.ByteString -> Int+decode_i8 = Convert.int8_to_int . Binary.decode++-- | Decode an unsigned 8-bit integer.+decode_u16 :: ByteString.Lazy.ByteString -> Int+decode_u16 = Convert.word16_to_int . decode_word16++-- | Little-endian variant of 'decode_u16'.+decode_u16_le :: ByteString.Lazy.ByteString -> Int+decode_u16_le = Convert.word16_to_int . decode_word16_le++-- | Decode a signed 16-bit integer.+decode_i16 :: ByteString.Lazy.ByteString -> Int+decode_i16 = Convert.int16_to_int . decode_int16++-- | Little-endian variant of 'decode_i16'.+decode_i16_le :: ByteString.Lazy.ByteString -> Int+decode_i16_le = decode_i16 . ByteString.Lazy.reverse++{- | Decode a signed 32-bit integer.++>>> decode_i32 (ByteString.Lazy.pack [0x00,0x00,0x03,0xe7]) == 0x03e7+True+-}+decode_i32 :: ByteString.Lazy.ByteString -> Int+decode_i32 = Convert.int32_to_int . Binary.decode++{- | Little-endian variant of 'decode_i32'.++>>> decode_i32_le (ByteString.Lazy.pack [0xe7,0x03,0x00,0x00]) == 0x03e7+True+-}+decode_i32_le :: ByteString.Lazy.ByteString -> Int+decode_i32_le = decode_i32 . ByteString.Lazy.reverse++{- | Decode an unsigned 32-bit integer.++>>> decode_u32 (ByteString.Lazy.pack [1,2,3,4]) == 0x01020304+True+-}+decode_u32 :: ByteString.Lazy.ByteString -> Int+decode_u32 = Convert.word32_to_int . decode_word32++{- | Little-endian variant of decode_u32.++>>> decode_u32_le (ByteString.Lazy.pack [1,2,3,4]) == 0x04030201+True+-}+decode_u32_le :: ByteString.Lazy.ByteString -> Int+decode_u32_le = Convert.word32_to_int . decode_word32_le++-- * Decode/Float++{- | Decode a 32-bit IEEE floating point number.++>>> decode_f32 (ByteString.Lazy.pack [64,73,6,37])+3.141+-}+decode_f32 :: ByteString.Lazy.ByteString -> Float+decode_f32 = Binary.Get.runGet Binary.Get.getFloatbe++-- | Little-endian variant of 'decode_f32'.+decode_f32_le :: ByteString.Lazy.ByteString -> Float+decode_f32_le = Binary.Get.runGet Binary.Get.getFloatle++-- | Decode a 64-bit IEEE floating point number.+decode_f64 :: ByteString.Lazy.ByteString -> Double+decode_f64 = Binary.Get.runGet Binary.Get.getDoublebe++-- * Decode/Ascii++-- | Decode an Ascii string, inverse of 'encode_ascii'.+decode_ascii :: ByteString.Lazy.ByteString -> ByteString.Char8.ByteString+{-# INLINE decode_ascii #-}+decode_ascii = ByteString.Char8.pack . ByteString.Lazy.Char8.unpack++-- * IO++-- | Read /n/ bytes from /h/ and run /f/.+read_decode :: (ByteString.Lazy.ByteString -> t) -> Int -> Handle -> IO t+read_decode f n = fmap f . flip ByteString.Lazy.hGet n++-- | Type-specialised reader for 'Binary.decode'.+read_word32 :: Handle -> IO Word32+read_word32 = read_decode Binary.decode 4++-- | 'read_decode' of 'decode_word32_le'.+read_word32_le :: Handle -> IO Word32+read_word32_le = read_decode decode_word32_le 4++-- | 'ByteString.Lazy.hPut' of 'encode_word32'.+write_word32 :: Handle -> Word32 -> IO ()+write_word32 h = ByteString.Lazy.hPut h . encode_word32++-- | 'ByteString.Lazy.hPut' of 'encode_word32_le'.+write_word32_le :: Handle -> Word32 -> IO ()+write_word32_le h = ByteString.Lazy.hPut h . encode_word32_le++-- * Io/Int++-- | 'decode_i8' of 'ByteString.Lazy.hGet'.+read_i8 :: Handle -> IO Int+read_i8 = read_decode decode_i8 1++-- | 'decode_i16' of 'ByteString.Lazy.hGet'.+read_i16 :: Handle -> IO Int+read_i16 = read_decode decode_i16 2++-- | 'decode_i32' of 'ByteString.Lazy.hGet'.+read_i32 :: Handle -> IO Int+read_i32 = read_decode decode_i32 4++-- | 'decode_i32_le' of 'ByteString.Lazy.hGet'.+read_i32_le :: Handle -> IO Int+read_i32_le = read_decode decode_i32_le 4++-- | 'decode_u32' of 'ByteString.Lazy.hGet'.+read_u32 :: Handle -> IO Int+read_u32 = read_decode decode_u32 4++-- | 'decode_u32_le' of 'ByteString.Lazy.hGet'.+read_u32_le :: Handle -> IO Int+read_u32_le = read_decode decode_u32_le 4++-- | 'ByteString.Lazy.hPut' of 'encode_u32'.+write_u32 :: Handle -> Int -> IO ()+write_u32 h = ByteString.Lazy.hPut h . encode_u32++-- | 'ByteString.Lazy.hPut' of 'encode_u32_le'.+write_u32_le :: Handle -> Int -> IO ()+write_u32_le h = ByteString.Lazy.hPut h . encode_u32_le++-- * Io/Float++-- | 'decode_f32' of 'ByteString.Lazy.hGet'.+read_f32 :: Handle -> IO Float+read_f32 = read_decode decode_f32 4++-- | 'decode_f32_le' of 'ByteString.Lazy.hGet'.+read_f32_le :: Handle -> IO Float+read_f32_le = read_decode decode_f32_le 4++-- * Io/Ascii++-- | Read u8 length prefixed Ascii string (pascal string).+read_pstr :: Handle -> IO ByteString.Char8.ByteString+read_pstr h = do+  n <- fmap decode_u8 (ByteString.Lazy.hGet h 1)+  fmap decode_ascii (ByteString.Lazy.hGet h n)++-- * Util++{- | Bundle header as a (strict) 'ByteString.Char8.ByteString'.++>>> ByteString.Char8.length bundleHeader_strict+8+-}+bundleHeader_strict :: ByteString.Char8.ByteString+bundleHeader_strict = ByteString.Char8.pack "#bundle\0"++{- | Bundle header as a lazy ByteString.++>>> ByteString.Lazy.length bundleHeader+8+-}+bundleHeader :: ByteString.Lazy.ByteString+{-# INLINE bundleHeader #-}+bundleHeader = ByteString.Lazy.Char8.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]++>>> map align [512::Int .. 519]+[0,3,2,1,0,3,2,1]+-}+align :: (Num i, Bits i) => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n++-- * ByteString++-- | Is machine little endian?+isLittleEndian :: Bool+isLittleEndian = GHC.ByteOrder.targetByteOrder == GHC.ByteOrder.LittleEndian++-- | Byte-swap byte string in four-byte segments.+byteStringSwap32BitWords :: ByteString.ByteString -> ByteString.ByteString+byteStringSwap32BitWords xs =+  ByteString.Internal.unsafePackLenBytes+    (ByteString.length xs `quot` 4 * 4)+    [ ByteString.Unsafe.unsafeIndex xs $ i * 4 + j+    | i <- [0 .. ByteString.length xs `quot` 4 - 1]+    , j <- [3, 2, 1, 0]+    ]++-- | If target is little-endian, swap bytes to be in network order, else identity.+byteString32BitNetworkOrder :: ByteString.ByteString -> ByteString.ByteString+byteString32BitNetworkOrder x = if isLittleEndian then byteStringSwap32BitWords x else x

+ Sound/Osc/Coding/Cast.hs view

@@ -0,0 +1,72 @@+-- | Bit-level type casts and byte layout string typecasts.+module Sound.Osc.Coding.Cast where++import Data.Char {- base -}+import Data.Word {- base -}++import Sound.Osc.Coding.Byte {- hosc3 -}+import Sound.Osc.Coding.Convert {- hosc -}++{- | The IEEE byte representation of a float.++>>> f32_w32 pi+1078530011++>>> f32_w32 (-7913907.5)+3404825447++>>> 23 ^ 7+3404825447+-}+f32_w32 :: Float -> Word32+f32_w32 = decode_word32 . encode_f32++{- | Inverse of 'f32_w32'.++>>> w32_f32 1078530011+3.1415927++>>> w32_f32 (23 ^ 7)+-7913907.5+-}+w32_f32 :: Word32 -> Float+w32_f32 = decode_f32 . encode_word32++{- | The IEEE byte representation of a double.+++>>> f64_w64 pi+4614256656552045848++>>> f64_w64 1.6822072834e-314+3404825447+-}+f64_w64 :: Double -> Word64+f64_w64 = decode_word64 . encode_f64++{- | Inverse of 'f64_w64'.++>>> w64_f64 4614256656552045848+3.141592653589793++>>> w64_f64 (23 ^ 7)+1.6822072834e-314+-}+w64_f64 :: Word64 -> Double+w64_f64 = decode_f64 . encode_word64++-- | Transform a haskell string into a C string (a null suffixed byte string).+str_cstr :: String -> [Word8]+str_cstr s = map (int_to_word8 . ord) s ++ [0]++-- | Inverse of 'str_cstr'.+cstr_str :: [Word8] -> String+cstr_str = map (chr . word8_to_int) . takeWhile (/= 0)++-- | Transform a haskell string to a pascal string (a length prefixed byte string).+str_pstr :: String -> [Word8]+str_pstr s = int_to_word8 (length s) : map (int_to_word8 . ord) s++-- | Inverse of 'str_pstr'.+pstr_str :: [Word8] -> String+pstr_str = map (chr . word8_to_int) . drop 1

+ Sound/Osc/Coding/Convert.hs view

@@ -0,0 +1,129 @@+-- | Type conversion.+module Sound.Osc.Coding.Convert where++import Data.Int {- base -}+import Data.Word {- base -}++-- * Int -> N++-- | 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'+int_to_int64 :: Int -> Int64+int_to_int64 = fromIntegral++-- * N -> Int++-- | 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'+int64_to_int :: Int64 -> Int+int64_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++-- * N -> N++-- | Type specialised 'fromIntegral'+word16_to_word32 :: Word16 -> Word32+word16_to_word32 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_word16 :: Word32 -> Word16+word32_to_word16 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_int32 :: Word32 -> Int32+word32_to_int32 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_int64 :: Word32 -> Int64+word32_to_int64 = fromIntegral++-- | Type specialised 'fromIntegral'+word64_to_int64 :: Word64 -> Int64+word64_to_int64 = fromIntegral++-- | Type specialised 'fromIntegral'+int64_to_int32 :: Int64 -> Int32+int64_to_int32 = fromIntegral++-- | Type specialised 'fromIntegral'+int64_to_word32 :: Int64 -> Word32+int64_to_word32 = fromIntegral++-- * N -> Real++-- | Type specialised 'fromIntegral'+word64_to_double :: Word64 -> Double+word64_to_double = fromIntegral++-- * Enum++-- | Type-specialised 'toEnum' of 'fromIntegral'+word8_to_enum :: Enum e => Word8 -> e+word8_to_enum = toEnum . fromIntegral++-- | Type-specialised 'toEnum' of 'fromIntegral'+word16_to_enum :: Enum e => Word16 -> e+word16_to_enum = toEnum . fromIntegral++-- | Type-specialised 'fromIntegral' of 'fromEnum'.+enum_to_word8 :: Enum e => e -> Word8+enum_to_word8 = fromIntegral . fromEnum++-- | Type-specialised 'fromIntegral' of 'fromEnum'.+enum_to_word16 :: Enum e => e -> Word16+enum_to_word16 = fromIntegral . fromEnum++-- * Enum/Char++-- | Type-specialised 'word8_to_enum'.+word8_to_char :: Word8 -> Char+word8_to_char = word8_to_enum++-- | Type-specialised 'enum_to_word8'.+char_to_word8 :: Char -> Word8+char_to_word8 = enum_to_word8

+ Sound/Osc/Coding/Decode/Base.hs view

@@ -0,0 +1,122 @@+{- | 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.Coding.Convert {- 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 :: DatumType -> B.ByteString -> Int+size ty b =+  case ty of+    'i' -> 4 -- Int32+    'f' -> 4 -- Float+    'd' -> 8 -- Double+    't' -> 8 -- Time (NTP)+    'm' -> 4 -- MIDI+    's' ->+      int64_to_int+        ( 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 (aligned) of an Osc value.+storage :: DatumType -> 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 :: DatumType -> 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' -> AsciiString (decode_ascii (b_take (size 's' b) b))+    'b' -> Blob (b_take (size 'b' b) (B.drop 4 b))+    't' -> TimeStamp (ntpi_to_ntpr (decode_word64 b))+    'm' ->+      case B.unpack (B.take 4 b) of+        [b0, b1, b2, b3] -> midi (b0, b1, b2, b3)+        _ -> error "decode_datum: illegal midi data"+    _ -> 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 (int_to_int64 (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+      cmd = decode_datum 's' b+      m = storage 's' (b_drop n b)+  in case (cmd, decode_datum 's' (b_drop n b)) of+      (AsciiString cmd', AsciiString dsc) ->+        let arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b)+        in Message (C.unpack cmd') arg+      _ -> error "decodeMessage"++-- | Decode a sequence of length prefixed (Int32) Osc messages.+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 -> BundleOf Message+decodeBundle b =+  let h = storage 's' b -- header (should be '#bundle')+      t = storage 't' (b_drop h b) -- time+  in case decode_datum 't' (b_drop h b) of+      TimeStamp timeStamp -> Bundle timeStamp (decode_message_seq (b_drop (h + t) b))+      _ -> error "decodeBundle"++{- | Decode an Osc 'Packet'.++>>> 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])+True+-}+decodePacket :: B.ByteString -> PacketOf Message+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 . int_to_int64++-- | 'B.drop' with 'Int' count.+b_drop :: Int -> B.ByteString -> B.ByteString+b_drop = B.drop . int_to_int64

+ Sound/Osc/Coding/Decode/Binary.hs view

@@ -0,0 +1,152 @@+-- | Optimised decode function for Osc packets.+module Sound.Osc.Coding.Decode.Binary (+  get_packet,+  decodeMessage,+  decodeBundle,+  decodePacket,+  decodePacket_strict,+  decodeMessageOr,+  decodeBundleOr,+  decodePacketOr,+) where++import Control.Applicative {- base -}+import Control.Monad {- base -}+import Data.Word {- base -}++import qualified Data.Binary.Get as Binary {- binary -}++import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import qualified Sound.Osc.Time as Time {- hosc -}++-- | Get an aligned Osc string.+get_string :: Binary.Get String+get_string = do+  s <- Binary.getLazyByteStringNul+  Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))+  return (ByteString.Lazy.Char8.unpack s)++-- | Get an aligned Osc string.+get_ascii :: Binary.Get Ascii+get_ascii = do+  s <- Binary.getLazyByteStringNul+  Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))+  return (ByteString.Char8.pack (ByteString.Lazy.Char8.unpack s))++-- | Get binary data prefixed by byte count.+get_bytes :: Word32 -> Binary.Get ByteString.Lazy.ByteString+get_bytes n = do+  b <- Binary.getLazyByteString (Convert.word32_to_int64 n)+  if n /= Convert.int64_to_word32 (ByteString.Lazy.length b)+    then fail "get_bytes: end of stream"+    else Binary.skip (Convert.word32_to_int (Byte.align n))+  return b++-- | Get an Osc datum.+get_datum :: DatumType -> Binary.Get Datum+get_datum ty =+  case ty of+    'i' -> fmap Int32 Binary.getInt32be+    'h' -> fmap Int64 Binary.getInt64be+    'f' -> fmap Float Binary.getFloatbe+    'd' -> fmap Double Binary.getDoublebe+    's' -> fmap AsciiString get_ascii+    'b' -> fmap Blob (get_bytes =<< Binary.getWord32be)+    't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) Binary.getWord64be+    'm' -> fmap Midi (liftM4 MidiData Binary.getWord8 Binary.getWord8 Binary.getWord8 Binary.getWord8)+    _ -> fail ("get_datum: illegal type " ++ show ty)++-- | Get an Osc 'Message', fail if type descriptor is invalid.+get_message :: Binary.Get Message+get_message = do+  cmd <- get_string+  dsc <- get_ascii+  case ByteString.Char8.unpack dsc of+    ',' : tags -> do+      arg <- mapM get_datum tags+      return (Message cmd arg)+    e -> fail ("get_message: invalid type descriptor string: " ++ e)++-- | Get a sequence of Osc 'Message's, each one headed by its length.+get_message_seq :: Binary.Get [Message]+get_message_seq = do+  b <- Binary.isEmpty+  if b+    then return []+    else do+      p <- flip Binary.isolate get_message . Convert.word32_to_int =<< Binary.getWord32be+      ps <- get_message_seq+      return (p : ps)++-- | Get a bundle. Fail if bundle header is not found in packet.+get_bundle :: Binary.Get (BundleOf Message)+get_bundle = do+  h <- Binary.getByteString (ByteString.Char8.length Byte.bundleHeader_strict)+  when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle")+  t <- fmap Time.ntpi_to_ntpr Binary.getWord64be+  fmap (Bundle t) get_message_seq++-- | Get an Osc 'Packet'.+get_packet :: Binary.Get (PacketOf Message)+get_packet = fmap Packet_Bundle get_bundle <|> fmap Packet_Message get_message++{-# INLINE decodeMessage #-}+{-# INLINE decodeBundle #-}+{-# INLINE decodePacket #-}+{-# INLINE decodePacket_strict #-}++{- | Decode an Osc 'Message' from a lazy ByteString.++>>> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> decodeMessage b == Message "/g_free" [Int32 0]+True+-}+decodeMessage :: ByteString.Lazy.ByteString -> Message+decodeMessage = Binary.runGet get_message++-- | Decode an Osc 'Bundle' from a lazy ByteString.+decodeBundle :: ByteString.Lazy.ByteString -> BundleOf Message+decodeBundle = Binary.runGet get_bundle++-- | Run decoder and report any error.+runDecoder :: Binary.Get t -> ByteString.Lazy.Char8.ByteString -> Either String t+runDecoder f p =+  case Binary.runGetOrFail f p of+    Left (_, _, err) -> Left err+    Right (_, _, decoded) -> Right decoded++{- | Decode an Osc packet from a lazy ByteString.++>>> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> decodePacket b == Packet_Message (Message "/g_free" [Int32 0])+True+-}+decodePacket :: ByteString.Lazy.ByteString -> PacketOf Message+decodePacket = Binary.runGet get_packet++-- | Decode an Osc packet from a strict Char8 ByteString.+decodePacket_strict :: ByteString.Char8.ByteString -> PacketOf Message+decodePacket_strict = Binary.runGet get_packet . ByteString.Lazy.fromChunks . (: [])++{- | Either decode Osc message or return an error message.+Prevents application halt for non-valid message/bundle/packet arrives.++>>> let b = ByteString.Lazy.pack [1,2,3,2,1]+>>> decodePacketOr b+Left "not enough bytes"+-}+decodeMessageOr :: ByteString.Lazy.ByteString -> Either String Message+decodeMessageOr = runDecoder get_message++decodeBundleOr :: ByteString.Lazy.ByteString -> Either String Bundle+decodeBundleOr = runDecoder get_bundle++decodePacketOr :: ByteString.Lazy.ByteString -> Either String Packet+decodePacketOr = runDecoder get_packet

+ Sound/Osc/Coding/Encode/Base.hs view

@@ -0,0 +1,117 @@+{- | 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.Coding.Convert {- 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'.++MidiData: Bytes from MSB to LSB are: port id, status byte, data1, data2.++>>> encode_datum (blob [1, 2, 3, 4]) == B.pack [0, 0, 0, 4, 1, 2, 3, 4]+True++>>> encode_datum (Float 1) == B.pack [63, 128, 0, 0]+True++>>> encode_datum (Float 2) == B.pack [64, 0, 0, 0]+True++>>> encode_datum (Float 3) == B.pack [64, 64, 0, 0]+True++>>> encode_datum (Float 4) == B.pack [64, 128, 0, 0]+True++>>> encode_datum (Float 5) == B.pack [64, 160, 0, 0]+True++>>> encode_datum (Int32 65536) == B.pack [0, 1, 0, 0]+True++>>> encode_datum (Int32 (-65536)) == B.pack [255, 255, 0, 0]+True+-}+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_word64 $ ntpr_to_ntpi t+    AsciiString s -> extend 0 (B.snoc (encode_ascii s) 0)+    Midi (MidiData b0 b1 b2 b3) -> B.pack [b0, b1, b2, b3]+    Blob b ->+      let n = encode (int64_to_int32 (B.length b))+      in B.append n (extend 0 b)++{- | Encode Osc 'Message'.++>>> blob_unpack (encodeMessage (Message "/x" []))+[47,120,0,0,44,0,0,0]++>>> blob_unpack (encodeMessage (Message "/y" [float 3.141]))+[47,121,0,0,44,102,0,0,64,73,6,37]++>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]+>>> let e = blob_unpack (encodeMessage m)+>>> length e+40++>>> take 20 e+[47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255]+-}+encodeMessage :: Message -> B.ByteString+encodeMessage (Message c l) =+  B.concat+    [ encode_datum (AsciiString (C.pack c))+    , encode_datum (AsciiString (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'.++>>> blob_unpack (encodeBundle (Bundle immediately [Message "/x" []]))+[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,8,47,120,0,0,44,0,0,0]++>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]+>>> let b = Bundle 0.0 [m]+>>> let e = blob_unpack (encodeBundle b)+>>> length e+60++>> take 20 e+[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,0,0,0,0,40]+-}+encodeBundle :: BundleOf Message -> B.ByteString+encodeBundle (Bundle t m) =+  B.concat+    [ bundleHeader+    , encode_word64 (ntpr_to_ntpi t)+    , B.concat (map (encode_datum . encode_message_blob) m)+    ]++-- | Encode Osc 'Packet'.+encodePacket :: PacketOf Message -> B.ByteString+encodePacket o =+  case o of+    Packet_Message m -> encodeMessage m+    Packet_Bundle b -> encodeBundle b

+ Sound/Osc/Coding/Encode/Builder.hs view

@@ -0,0 +1,115 @@+-- | 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 Blaze.ByteString.Builder as B {- bytestring -}+import qualified Blaze.ByteString.Builder.Char8 as B {- bytestring -}+import qualified Data.ByteString as S {- bytestring -}+import qualified Data.ByteString.Lazy as L {- bytestring -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Cast as Cast {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- 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 :: Int -> [Word8]+padding n = replicate 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 <> nul_and_padding (S.length s + 1)++-- Encode a string with zero padding.+build_string :: String -> B.Builder+build_string s = B.fromString s <> 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 (Convert.int64_to_int32 (L.length s))+    <> B.fromLazyByteString s+    <> B.fromWord8s (padding (Convert.int64_to_int (Byte.align (L.length s))))++-- Encode an Osc datum.+build_datum :: Datum -> B.Builder+build_datum d =+  case d of+    Int32 i -> B.fromInt32be i+    Int64 i -> B.fromInt64be i+    Float n -> B.fromWord32be (Cast.f32_w32 n)+    Double n -> B.fromWord64be (Cast.f64_w64 n)+    TimeStamp t -> B.fromWord64be (ntpr_to_ntpi t)+    AsciiString s -> build_ascii s+    Midi (MidiData 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 :: PacketOf Message -> 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 :: PacketOf Message -> 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+True+-}+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+True+-}+encodeBundle :: BundleOf Message -> L.ByteString+encodeBundle = encodePacket . Packet_Bundle++-- | Encode an Osc 'Packet' to a strict 'S.ByteString'.+encodePacket_strict :: PacketOf Message -> S.ByteString+encodePacket_strict = B.toByteString . build_packet

+ Sound/Osc/Core.hs view

@@ -0,0 +1,21 @@+{- | Composite of non-transport related modules.++Provides the 'Datum', 'Message', 'Time', 'Bundle' and 'Packet' types+and the coding functions 'encodePacket' and 'decodePacket'.++>>> let o = bundle immediately [message "/g_free" [Int32 0]]+>>> let e = encodeBundle o+>>> decodePacket e == Packet_Bundle o+True+-}+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.Time.System as M+import Sound.Osc.Time.Thread as M+import Sound.Osc.Time.Thread.MonadIO as M+import Sound.Osc.Wait as M

+ Sound/Osc/Datum.hs view

@@ -0,0 +1,264 @@+-- | Osc data types.+module Sound.Osc.Datum where++import Data.Int {- base -}+import Data.Maybe {- base -}+import Data.Word {- base -}++import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}++-- * Datum++-- | Type enumerating Datum categories.+type DatumType = Char++-- | Type for Ascii strings (strict Char8 ByteString)+type Ascii = ByteString.Char8.ByteString++-- | Type-specialised pack.+ascii :: String -> Ascii+ascii = ByteString.Char8.pack++-- | Type-specialised unpack.+ascii_to_string :: Ascii -> String+ascii_to_string = ByteString.Char8.unpack++-- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix.+type Blob = ByteString.Lazy.ByteString++-- | Type-specialised pack.+blob_pack :: [Word8] -> Blob+blob_pack = ByteString.Lazy.pack++-- | Type-specialised pack.+blob_pack_int :: [Int] -> Blob+blob_pack_int = ByteString.Lazy.pack . map fromIntegral++-- | Type-specialised unpack.+blob_unpack :: Blob -> [Word8]+blob_unpack = ByteString.Lazy.unpack++-- | Type-specialised unpack.+blob_unpack_int :: Blob -> [Int]+blob_unpack_int = map fromIntegral . blob_unpack++-- | Four-byte midi message: port-id, status-byte, data, data.+data MidiData = MidiData !Word8 !Word8 !Word8 !Word8+  deriving (Ord, Eq, Show, Read)++midi_pack :: [Word8] -> MidiData+midi_pack w =+  case w of+    [m1, m2, m3, m4] -> MidiData m1 m2 m3 m4+    _ -> error "midi_pack?"++-- | Type-specialised pack.+midi_pack_int :: [Int] -> MidiData+midi_pack_int = midi_pack . map fromIntegral++-- | Type-specialised unpack.+midi_unpack_int :: MidiData -> [Int]+midi_unpack_int (MidiData m1 m2 m3 m4) = map fromIntegral [m1, m2, m3, m4]++{- | A real-valued time stamp.+For Osc proper this is an Ntp64 time in real-valued (fractional) form.+For SuperCollider Nrt programs this is elapsed time since the start of the score.+This is the primary form of timestamp used by hosc.+-}+type Time = Double++-- | The basic elements of Osc messages.+data Datum+  = Int32 {d_int32 :: !Int32}+  | Int64 {d_int64 :: !Int64}+  | Float {d_float :: !Float}+  | Double {d_double :: !Double}+  | AsciiString {d_ascii_string :: !Ascii}+  | Blob {d_blob :: !Blob}+  | TimeStamp {d_timestamp :: !Time} -- ie. real valued Ntp+  | Midi {d_midi :: !MidiData}+  deriving (Ord, Eq, Read, Show)++-- * Datum types++-- | List of required data types (tag, name).+osc_types_required :: [(DatumType, String)]+osc_types_required =+  [ ('i', "Int32")+  , ('f', "Float")+  , ('s', "String") -- Ascii+  , ('b', "Blob")+  ]++-- | List of optional data types (tag,name).+osc_types_optional :: [(DatumType, String)]+osc_types_optional =+  [ ('h', "Int64")+  , ('t', "TimeStamp")+  , ('d', "Double")+  , -- ,('S',"Symbol")+    -- ,('c',"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 :: [(DatumType, String)]+osc_types = osc_types_required ++ osc_types_optional++-- | Lookup name of type.+osc_type_name :: DatumType -> Maybe String+osc_type_name c = lookup c osc_types++-- | Erroring variant.+osc_type_name_err :: DatumType -> String+osc_type_name_err = fromMaybe (error "osc_type_name") . osc_type_name++-- | Single character identifier of an Osc datum.+datum_tag :: Datum -> DatumType+datum_tag d =+  case d of+    Int32 _ -> 'i'+    Int64 _ -> 'h'+    Float _ -> 'f'+    Double _ -> 'd'+    AsciiString _ -> 's'+    Blob _ -> 'b'+    TimeStamp _ -> 't'+    Midi _ -> 'm'++-- | Type and name of 'Datum'.+datum_type_name :: Datum -> (DatumType, 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]+True+-}+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)+True+-}+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)+True++>>> d_int32 (int32 (maxBound::Int32)) == maxBound+True++>>> int32 (((2::Int) ^ (64::Int))::Int) == Int32 0+True+-}+int32 :: Integral n => n -> Datum+int32 = Int32 . fromIntegral++{- | Type generalised Int64.++>>> int64 (1::Int32) == int64 (1::Integer)+True++>>> d_int64 (int64 (maxBound::Int64)) == maxBound+True+-}+int64 :: Integral n => n -> Datum+int64 = Int64 . fromIntegral++{- | Type generalised Float.++>>> float (1::Int) == float (1::Double)+True++>>> 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)+True++>>> double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77+True+-}+double :: Real n => n -> Datum+double = Double . realToFrac++{- | 'AsciiString' of pack.++>>> string "string" == AsciiString (ByteString.Char8.pack "string")+True+-}+string :: String -> Datum+string = AsciiString . ascii++{- | Four-tuple variant of 'Midi' '.' 'MidiData'.++>>> midi (0,0,0,0) == Midi (MidiData 0 0 0 0)+True+-}+midi :: (Word8, Word8, Word8, Word8) -> Datum+midi (p, q, r, s) = Midi (MidiData p q r s)++-- | 'Blob' of 'blob_pack'.+blob :: [Word8] -> Datum+blob = Blob . blob_pack++-- * Descriptor++{- | Message argument types are given by a signature.++>>> signatureFor [Int32 1,Float 1,string "1"]+",ifs"+-}+signatureFor :: [Datum] -> String+signatureFor = (',' :) . map datum_tag++{- | The descriptor is an Ascii encoded signature.++>>> descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"+True+-}+descriptor :: [Datum] -> Ascii+descriptor = ascii . signatureFor++-- | Descriptor tags are @comma@ prefixed.+descriptor_tags :: Ascii -> Ascii+descriptor_tags = ByteString.Char8.drop 1

+ Sound/Osc/Fd.hs view

@@ -0,0 +1,6 @@+-- | 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.Socket as M

+ Sound/Osc/Packet.hs view

@@ -0,0 +1,142 @@+-- | Data types for Osc messages, bundles and packets.+module Sound.Osc.Packet where++import Sound.Osc.Datum {- hosc -}++-- * Message++{- | Osc address pattern.  This is strictly an Ascii value, however it+  is very common to pattern match on addresses and matching on+  Data.ByteString.Char8 requires @OverloadedStrings@.+-}+type Address_Pattern = String++-- | An Osc message, an 'Address_Pattern' and a sequence of 'Datum'.+data Message = Message+  { messageAddress :: !Address_Pattern+  , messageDatum :: ![Datum]+  }+  deriving (Ord, 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"++messageSignature :: Message -> String+messageSignature = signatureFor . messageDatum++messageDescriptor :: Message -> Ascii+messageDescriptor = descriptor . messageDatum++-- * Bundle++{- | An Osc bundle, a 'Time' and a sequence of 'Message's.+The type parameter specifies the element type.+Ordinarily this is Message, which does not allow recursion.+-}+data BundleOf t = Bundle+  { bundleTime :: !Time+  , bundleMessages :: ![t]+  }+  deriving (Eq, Read, Show)++type Bundle = BundleOf Message++-- | Osc 'Bundle's can be ordered (time ascending).+instance Eq t => Ord (BundleOf t) where+  compare (Bundle a _) (Bundle b _) = compare a b++-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is empty.+bundle :: Time -> [t] -> BundleOf t+bundle t xs =+  case xs of+    [] -> error "bundle: empty?"+    _ -> Bundle t xs++-- * Packet++-- | An Osc 'Packet' is either a 'Message' or a 'Bundle t'.+data PacketOf t+  = Packet_Message {packetMessage :: !Message}+  | Packet_Bundle {packetBundle :: !(BundleOf t)}+  deriving (Eq, Read, Show)++type Packet = PacketOf Message++-- | 'Packet_Bundle' of 'bundle'.+p_bundle :: Time -> [t] -> PacketOf t+p_bundle t = Packet_Bundle . bundle t++-- | 'Packet_Message' of 'message'.+p_message :: Address_Pattern -> [Datum] -> PacketOf t+p_message a = Packet_Message . message a++{- | Constant indicating a bundle to be executed immediately.+It has the Ntp64 representation of @1@.++>>> immediately == (1 / (2 ^ 32))+True+-}+immediately :: Time+immediately = 1 / 2 ^ (32 :: Int)++-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is 'immediately'.+packetTime :: PacketOf t -> Time+packetTime = at_packet (const immediately) bundleTime++-- | Retrieve the set of 'Message's from a 'Packet'.+packetMessages :: PacketOf Message -> [Message]+packetMessages = at_packet return bundleMessages++-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.+packet_to_bundle :: PacketOf Message -> BundleOf Message+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 :: PacketOf Message -> 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 :: PacketOf t -> Bool+packet_is_immediate = (== immediately) . packetTime++-- | Variant of 'either' for 'Packet'.+at_packet :: (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> 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 Message' have the specified+'Address_Pattern'.+-}+bundle_has_address :: Address_Pattern -> BundleOf Message -> 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 -> PacketOf Message -> Bool+packet_has_address x =+  at_packet+    (message_has_address x)+    (bundle_has_address x)

+ Sound/Osc/Text.hs view

@@ -0,0 +1,279 @@+-- | A simple and unambigous text encoding for Osc.+module Sound.Osc.Text where++import Control.Monad {- base -}+import Data.Char {- base -}+import Numeric {- base -}+import Text.Printf {- base -}++import qualified Safe {- safe -}++import qualified Text.ParserCombinators.Parsec as P {- parsec -}++import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc3 -}+import qualified Sound.Osc.Time as Time {- hosc3 -}++-- | Precision value for floating point numbers.+type FpPrecision = Maybe Int++{- | Variant of 'showFFloat' that deletes trailing zeros.++>>> map (showFloatWithPrecision (Just 4)) [1, 2.0, pi]+["1.0","2.0","3.1416"]+-}+showFloatWithPrecision :: RealFloat n => FpPrecision -> n -> String+showFloatWithPrecision p n =+  let s = showFFloat p n ""+      s' = dropWhile (== '0') (reverse s)+  in case s' of+      '.' : _ -> reverse ('0' : s')+      _ -> reverse s'++{- | Hex encoded byte sequence.++>>> showBytes [0, 15, 16, 144, 255]+"000f1090ff"+-}+showBytes :: [Int] -> String+showBytes = concatMap (printf "%02x")++{- | Escape whites space (space, tab, newline) and the escape character (backslash).++>>> map escapeString ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"]+["str","str\\ ","st\\ r","s\\\tr","s\\\\tr","\\\nstr"]+-}+escapeString :: String -> String+escapeString txt =+  case txt of+    [] -> []+    c : txt' -> if c `elem` "\\\t\n " then '\\' : c : escapeString txt' else c : escapeString txt'++{- | Printer for Datum.++>>> let aDatumSeq = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16], TimeStamp 100.0]+>>> map (showDatum (Just 5)) aDatumSeq+["1","1.2","str","00904060","0c10","429496729600"]+-}+showDatum :: FpPrecision -> Datum -> String+showDatum p d =+  case d of+    Int32 n -> show n+    Int64 n -> show n+    Float n -> showFloatWithPrecision p n+    Double n -> showFloatWithPrecision p n+    AsciiString s -> escapeString (ascii_to_string s)+    Blob s -> showBytes (blob_unpack_int s)+    TimeStamp t -> show (Time.ntpr_to_ntpi t)+    Midi m -> showBytes (midi_unpack_int m)++{- | Printer for Message.++>>> let aMessage = Message "/addr" [Int32 1, Int64 2, Float 3, Double 4, string "five", blob [6, 7], midi (8, 9, 10, 11)]+>>> showMessage (Just 4) aMessage+"/addr ,ihfdsbm 1 2 3.0 4.0 five 0607 08090a0b"++>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3], Message "/s_new" [string "sine", Int32 (-1), Int32 1, Int32 1]]+>>> map (showMessage (Just 4)) aMessageSeq+["/c_set ,if 1 2.3","/s_new ,siii sine -1 1 1"]+-}+showMessage :: FpPrecision -> Message -> String+showMessage precision aMessage =+  unwords+    [ messageAddress aMessage+    , messageSignature aMessage+    , unwords (map (showDatum precision) (messageDatum aMessage))+    ]++{- | Printer for Bundle++>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> showBundle (Just 4) aBundle+"#bundle 4294967296 2 /c_set ,ifhd 1 2.3 4 5.6 /memset ,sb addr 0708"+-}+showBundle :: FpPrecision -> BundleOf Message -> String+showBundle precision aBundle =+  let messages = bundleMessages aBundle+  in unwords+      [ "#bundle"+      , show (Time.ntpr_to_ntpi (bundleTime aBundle))+      , show (length messages)+      , unwords (map (showMessage precision) messages)+      ]++-- | Printer for Packet.+showPacket :: FpPrecision -> PacketOf Message -> String+showPacket precision = at_packet (showMessage precision) (showBundle precision)++-- * Parser++-- | A character parser with no user state.+type P a = P.GenParser Char () a++-- | Run p then q, returning result of p.+(>>~) :: Monad m => m t -> m u -> m t+p >>~ q = p >>= \x -> q >> return x++-- | /p/ as lexeme, i.e. consuming any trailing white space.+lexemeP :: P t -> P t+lexemeP p = p >>~ P.many P.space++-- | Any non-space character.  Allow escaped space.+stringCharP :: P Char+stringCharP = (P.char '\\' >> P.space) P.<|> P.satisfy (\c -> not (isSpace c))++-- | Parser for string.+stringP :: P String+stringP = lexemeP (P.many1 stringCharP)++-- | Parser for Osc address.+oscAddressP :: P String+oscAddressP = do+  forwardSlash <- P.char '/'+  address <- stringP+  return (forwardSlash : address)++-- | Parser for Osc signature.+oscSignatureP :: P String+oscSignatureP =+  lexemeP+    ( do+        comma <- P.char ','+        types <- P.many1 (P.oneOf "ifsbhtdm") -- 1.0 = ifsb 2.0 = htdm+        return (comma : types)+    )++-- | Parser for decimal digit.+digitP :: P Char+digitP = P.oneOf "0123456789"++allowNegativeP :: Num n => P n -> P n+allowNegativeP p = do+  let optionMaybe x = P.option Nothing (liftM Just x) -- hugs...+  maybeNegative <- optionMaybe (P.char '-')+  number <- p+  return (maybe number (const (negate number)) maybeNegative)++-- | Parser for non-negative integer.+nonNegativeIntegerP :: (Integral n, Read n) => P n+nonNegativeIntegerP = lexemeP (fmap read (P.many1 digitP))++-- | Parser for integer.+integerP :: (Integral n, Read n) => P n+integerP = allowNegativeP nonNegativeIntegerP++-- | Parser for non-negative float.+nonNegativeFloatP :: (Fractional n, Read n) => P n+nonNegativeFloatP =+  lexemeP+    ( do+        integerPart <- P.many1 digitP+        _ <- P.char '.'+        fractionalPart <- P.many1 digitP+        return (read (concat [integerPart, ".", fractionalPart]))+    )++-- | Parser for non-negative float.+floatP :: (Fractional n, Read n) => P n+floatP = allowNegativeP nonNegativeFloatP++-- | Parser for hexadecimal digit.+hexdigitP :: P Char+hexdigitP = P.oneOf "0123456789abcdef"++-- | Byte parser.+byteP :: (Integral n, Read n) => P n+byteP = do+  c1 <- hexdigitP+  c2 <- hexdigitP+  case readHex [c1, c2] of+    [(r, "")] -> return r+    _ -> error "byteP?"++-- | Byte sequence parser.+byteSeqP :: (Integral n, Read n) => P [n]+byteSeqP = lexemeP (P.many1 byteP)++-- | Datum parser.+datumP :: Char -> P Datum+datumP typeChar = do+  case typeChar of+    'i' -> fmap Int32 integerP+    'f' -> fmap Float floatP+    's' -> fmap string stringP+    'b' -> fmap blob byteSeqP+    'h' -> fmap Int64 integerP+    'd' -> fmap Double floatP+    'm' -> fmap (Midi . midi_pack) (replicateM 4 byteP)+    't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) integerP+    _ -> error "datumP: type?"++-- | Message parser.+messageP :: P Message+messageP = do+  address <- oscAddressP+  typeSignature <- oscSignatureP+  datum <- mapM datumP (Safe.tailNote "messageP" typeSignature)+  return (Message address datum)++-- | Bundle tag parser.+bundleTagP :: P String+bundleTagP = lexemeP (P.string "#bundle")++-- | Bundle parser.+bundleP :: P (BundleOf Message)+bundleP = do+  _ <- bundleTagP+  timestamp <- fmap Time.ntpi_to_ntpr integerP+  messageCount <- integerP+  messages <- replicateM messageCount messageP+  return (Bundle timestamp messages)++-- | Packet parser.+packetP :: P (PacketOf Message)+packetP = (fmap Packet_Bundle bundleP) P.<|> (fmap Packet_Message messageP)++-- | Run parser.+runP :: P t -> String -> t+runP p txt =+  case P.parse p "" txt of+    Left err -> error (show err)+    Right r -> r++{- | Run datum parser.++>>> parseDatum 'i' "-1" == Int32 (-1)+True++>>> parseDatum 'f' "-2.3" == Float (-2.3)+True+-}+parseDatum :: Char -> String -> Datum+parseDatum typ = runP (datumP typ)++{- | Run message parser.++>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> map (parseMessage . showMessage (Just 4)) aMessageSeq  == aMessageSeq+True+-}+parseMessage :: String -> Message+parseMessage = runP messageP++{- | Run bundle parser.++>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> parseBundle (showBundle (Just 4) aBundle) == aBundle+True+-}+parseBundle :: String -> BundleOf Message+parseBundle = runP bundleP++{- | Run packet parser.++>>> let aPacket = Packet_Bundle (Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]])+>>> parsePacket (showPacket (Just 4) aPacket) == aPacket+True+-}+parsePacket :: String -> PacketOf Message+parsePacket = runP packetP

+ Sound/Osc/Time.hs view

@@ -0,0 +1,116 @@+{- | Osc related timing functions.+  Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.+-}+module Sound.Osc.Time where++import Data.Word {- base -}++import qualified Data.Time as Time {- time -}+import qualified Data.Time.Clock as Clock {- time -}+import qualified Data.Time.Clock.POSIX as Clock.Posix {- time -}++import Sound.Osc.Coding.Convert {- hosc -}++-- * Temporal types++{- | Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi).+  The Ntp epoch is January 1, 1900.+  Ntp v4 also includes a 128-bit format, which is not used by Osc.+-}+type Ntp64 = Word64++-- | @Ntp@ time in real-valued (fractional) form.+type NtpReal = Double++{- | @Unix/Posix@ time in real-valued (fractional) form.+  The Unix/Posix epoch is January 1, 1970.+-}+type PosixReal = Double++-- * Time conversion++{- | Convert an NtpReal timestamp to an Ntp64 timestamp.++>>> ntpr_to_ntpi 0+0++> fmap ntpr_to_ntpi time+-}+ntpr_to_ntpi :: NtpReal -> Ntp64+ntpr_to_ntpi t = round (t * (2 ^ (32 :: Int)))++{- | Convert an 'Ntp64' timestamp to a real-valued Ntp timestamp.++>>> ntpi_to_ntpr 0+0.0+-}+ntpi_to_ntpr :: Ntp64 -> NtpReal+ntpi_to_ntpr t = word64_to_double t / 2 ^ (32 :: Int)++{- | Difference (in seconds) between /Ntp/ and /Posix/ epochs.++>>> ntp_posix_epoch_diff / (24 * 60 * 60)+25567.0++>>> 25567 `div` 365+70+-}+ntp_posix_epoch_diff :: Num n => n+ntp_posix_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60++-- | Convert a PosixReal timestamp to an Ntp64 timestamp.+posix_to_ntpi :: PosixReal -> Ntp64+posix_to_ntpi t = ntpr_to_ntpi (t + ntp_posix_epoch_diff)++-- | Convert @Unix/Posix@ to @Ntp@.+posix_to_ntpr :: Num n => n -> n+posix_to_ntpr = (+) ntp_posix_epoch_diff++-- | Convert @Ntp@ to @Unix/Posix@.+ntpr_to_posix :: Num n => n -> n+ntpr_to_posix = (+) (negate ntp_posix_epoch_diff)++-- | Convert 'Ntp64' to @Unix/Posix@.+ntpi_to_posix :: Ntp64 -> PosixReal+ntpi_to_posix = ntpr_to_posix . ntpi_to_ntpr++-- | Convert 'Time' to 'Clock.Posix.POSIXTime'.+ntpr_to_posixtime :: NtpReal -> Clock.Posix.POSIXTime+ntpr_to_posixtime = realToFrac . ntpr_to_posix++-- | Convert 'Clock.Posix.POSIXTime' to 'Time'.+posixtime_to_ntpr :: Clock.Posix.POSIXTime -> NtpReal+posixtime_to_ntpr = posix_to_ntpr . realToFrac++-- * 'Data.Time' inter-operation.++-- | The time at 1970-01-01:00:00:00 which is the Unix/Posix epoch.+posix_epoch :: Time.UTCTime+posix_epoch =+  let d = Time.fromGregorian 1970 1 1+      s = fromInteger 0 -- Time.secondsToDiffTime+  in Time.UTCTime d s++-- | Convert 'Time.UTCTime' to @Unix/Posix@.+utc_to_posix :: Fractional n => Time.UTCTime -> n+utc_to_posix t = realToFrac (Time.diffUTCTime t posix_epoch)++-- * Clock operations++-- | utc_to_posix of Clock.getCurrentTime.+getCurrentTimeAsPosix :: IO PosixReal+getCurrentTimeAsPosix = fmap utc_to_posix Clock.getCurrentTime++{- | realToFrac of Clock.Posix.getPOSIXTime++> get_ct = getCurrentTimeAsPosix+> get_pt = getPosixTimeAsPosix+> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)+> print (pt - ct,pt - ct < 1e-5)+-}+getPosixTimeAsPosix :: IO PosixReal+getPosixTimeAsPosix = fmap realToFrac Clock.Posix.getPOSIXTime++-- | Read current real-valued @Ntp@ timestamp.+currentTime :: IO NtpReal+currentTime = fmap posixtime_to_ntpr Clock.Posix.getPOSIXTime

+ Sound/Osc/Time/System.hs view

@@ -0,0 +1,25 @@+-- | System time+module Sound.Osc.Time.System where++import Data.Int {- base -}+import Data.Word {- base -}++import qualified Data.Time.Clock.System as Clock.System {- time >= 1.8 -}++import qualified Sound.Osc.Time as Time {- hosc -}++{- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.+  getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs.+-}+getSystemTimeAsNtpReal :: IO Time.NtpReal+getSystemTimeAsNtpReal = do+  tm <- Clock.System.getSystemTime+  return (fromIntegral (Clock.System.systemSeconds tm) + (fromIntegral (Clock.System.systemNanoseconds tm) * 1.0e-9))++-- | System time with fractional part in microseconds (us) instead of nanoseconds (ns).+getSystemTimeInMicroseconds :: IO (Int64, Word32)+getSystemTimeInMicroseconds = do+  tm <- Clock.System.getSystemTime+  let sec = Clock.System.systemSeconds tm+      usec = Clock.System.systemNanoseconds tm `div` 1000+  return (sec, usec)

+ Sound/Osc/Time/Thread.hs view

@@ -0,0 +1,39 @@+-- | Thread operations.+module Sound.Osc.Time.Thread where++import Control.Concurrent {- base -}+import Control.Monad {- base -}++import qualified Sound.Osc.Time as Time {- hosc -}++{- | 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'.+pauseThreadFor :: RealFrac n => n -> IO ()+pauseThreadFor n = when (n > 0) (threadDelay (floor (n * 1e6)))++-- | Pause current thread until the given time, see 'pauseThreadLimit'.+pauseThreadUntilTime :: RealFrac n => n -> IO ()+pauseThreadUntilTime t = pauseThreadFor . (t -) . realToFrac =<< Time.currentTime++{- | Sleep current thread for the indicated duration (in seconds).+  Divides long sleeps into parts smaller than 'pauseThreadLimit'.+-}+sleepThreadFor :: RealFrac n => n -> IO ()+sleepThreadFor n =+  if n >= pauseThreadLimit+    then+      let n' = pauseThreadLimit - 1+      in pauseThreadFor n' >> sleepThreadFor (n - n')+    else pauseThreadFor n++{- | Sleep current thread until the given time.+  Divides long sleeps into parts smaller than 'pauseThreadLimit'.+-}+sleepThreadUntilTime :: RealFrac n => n -> IO ()+sleepThreadUntilTime t = sleepThreadFor . (t -) . realToFrac =<< Time.currentTime

+ Sound/Osc/Time/Thread/MonadIO.hs view

@@ -0,0 +1,25 @@+-- | MonadIO lifted forms of Sound.Osc.Time.Thread functions+module Sound.Osc.Time.Thread.MonadIO where++import Control.Monad.IO.Class {- base >= 4.9 -}++import qualified Sound.Osc.Time as Time {- hosc -}+import qualified Sound.Osc.Time.Thread as Time.Thread {- hosc -}++time :: MonadIO m => m Time.NtpReal+time = liftIO Time.currentTime++pauseThread :: (MonadIO m, RealFrac n) => n -> m ()+pauseThread = liftIO . Time.Thread.pauseThreadFor++wait :: MonadIO m => Double -> m ()+wait = pauseThread++pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m ()+pauseThreadUntil = liftIO . Time.Thread.pauseThreadUntilTime++sleepThread :: (RealFrac n, MonadIO m) => n -> m ()+sleepThread = liftIO . Time.Thread.sleepThreadFor++sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m ()+sleepThreadUntil = liftIO . Time.Thread.sleepThreadUntilTime

+ Sound/Osc/Time/Timeout.hs view

@@ -0,0 +1,15 @@+-- | Timeout, implemented independently of socket timeout setting.+module Sound.Osc.Time.Timeout where++import System.Timeout {- base -}++import Sound.Osc.Packet {- hsoc -}+import Sound.Osc.Transport.Fd {- hosc -}++-- | Variant of 'timeout' where time is given in fractional seconds.+timeout_r :: Double -> IO a -> IO (Maybe a)+timeout_r = timeout . floor . (* 1000000)++-- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.+recvPacketTimeout :: Transport t => Double -> t -> IO (Maybe (PacketOf Message))+recvPacketTimeout n fd = timeout_r n (recvPacket fd)

+ Sound/Osc/Transport/Fd.hs view

@@ -0,0 +1,101 @@+-- | 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 -> PacketOf Message -> IO ()++  -- | Receive and decode an Osc packet.+  recvPacket :: t -> IO (PacketOf Message)++  -- | Receive and either decode an Osc packet.+  recvPacketOr :: t -> IO (Either String 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 -> BundleOf Message -> IO ()+sendBundle t = sendPacket t . Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (Transport t) => t -> IO (BundleOf Message)+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++-- | Erroring variant.+recvMessage_err :: (Transport t) => t -> IO Message+recvMessage_err = fmap (fromMaybe (error "recvMessage")) . recvMessage++-- | Variant of 'recvPacket' that runs 'packetMessages'.+recvMessages :: (Transport t) => t -> IO [Message]+recvMessages = fmap packetMessages . recvPacket++-- * Wait++{- | Wait for a 'Packet' where the supplied predicate is 'True',+discarding intervening packets.+-}+waitUntil :: (Transport t) => t -> (PacketOf Message -> Bool) -> IO (PacketOf Message)+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 -> (PacketOf Message -> Maybe a) -> IO a+waitFor t f = Wait.untilMaybe f (recvPacket t)++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: Transport t => t -> IO (PacketOf Message)+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 (PacketOf Message)+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

+ Sound/Osc/Transport/Fd/Socket.hs view

@@ -0,0 +1,40 @@+-- | Osc over Udp/Tcp implementation.+module Sound.Osc.Transport.Fd.Socket where++import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}+import qualified Sound.Osc.Transport.Fd.Tcp as Fd.Tcp {- hosc -}+import qualified Sound.Osc.Transport.Fd.Udp as Fd.Udp {- hosc -}++-- | Protocol, either Udp or Tcp+data OscProtocol = Udp | Tcp+  deriving (Eq, Read, Show)++-- | Hostname+type OscHostname = String++-- | Port number+type OscPort = Int++-- | Socket address+type OscSocketAddress = (OscProtocol, OscHostname, OscPort)++-- | Socket+data OscSocket = OscUdpSocket Fd.Udp.Udp | OscTcpSocket Fd.Tcp.Tcp++-- | Open socket at address+openOscSocket :: OscSocketAddress -> IO OscSocket+openOscSocket address =+  case address of+    (Tcp, hostname, port) -> fmap OscTcpSocket (Fd.Tcp.openTcp hostname port)+    (Udp, hostname, port) -> fmap OscUdpSocket (Fd.Udp.openUdp hostname port)++-- | 'OscSocket' is an instance of 'Fd.Transport'.+instance Fd.Transport OscSocket where+  sendPacket (OscTcpSocket fd) = Fd.Tcp.tcp_send_packet fd+  sendPacket (OscUdpSocket fd) = Fd.Udp.udp_send_packet fd+  recvPacket (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet fd+  recvPacket (OscUdpSocket fd) = Fd.Udp.udp_recv_packet fd+  recvPacketOr (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet_or fd+  recvPacketOr (OscUdpSocket fd) = Fd.Udp.udp_recv_packet_or fd+  close (OscTcpSocket fd) = Fd.Tcp.tcp_close fd+  close (OscUdpSocket fd) = Fd.Udp.udp_close fd

+ Sound/Osc/Transport/Fd/Tcp.hs view

@@ -0,0 +1,101 @@+-- | Osc over Tcp implementation.+module Sound.Osc.Transport.Fd.Tcp where++import qualified Control.Exception as Exception {- base -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Network.Socket as Socket {- network -}+import qualified System.IO as Io {- base -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import qualified Sound.Osc.Coding.Decode.Binary as Decode.Binary {- hosc -}+import qualified Sound.Osc.Coding.Encode.Builder as Encode.Builder {- hosc -}+import qualified Sound.Osc.Packet as Packet {- hosc -}+import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}++-- | The Tcp transport handle data type.+newtype Tcp = Tcp {tcpHandle :: Io.Handle}++-- | Send data over Tcp.+tcp_send_data :: Tcp -> ByteString.Lazy.ByteString -> IO ()+tcp_send_data (Tcp fd) d = do+  let n = Convert.int64_to_word32 (ByteString.Lazy.length d)+  ByteString.Lazy.hPut fd (ByteString.Lazy.append (Byte.encode_word32 n) d)+  Io.hFlush fd++-- | Send packet over Tcp.+tcp_send_packet :: Tcp -> Packet.PacketOf Packet.Message -> IO ()+tcp_send_packet tcp p = tcp_send_data tcp (Encode.Builder.encodePacket p)++-- | Receive packet over Tcp.+tcp_recv_packet :: Tcp -> IO (Packet.PacketOf Packet.Message)+tcp_recv_packet (Tcp fd) = do+  b0 <- ByteString.Lazy.hGet fd 4+  b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))+  return (Decode.Binary.decodePacket b1)++tcp_recv_packet_or :: Tcp -> IO (Either String Packet.Packet)+tcp_recv_packet_or (Tcp fd) = do+  b0 <- ByteString.Lazy.hGet fd 4+  b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))+  return (Decode.Binary.decodePacketOr 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+  recvPacketOr = tcp_recv_packet_or+  close = tcp_close++-- | Bracket Tcp 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 :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket.Socket+tcp_socket f host port = do+  fd <- Socket.socket Socket.AF_INET Socket.Stream 0+  let hints = Socket.defaultHints {Socket.addrFamily = Socket.AF_INET} -- localhost=ipv4+  i : _ <- Socket.getAddrInfo (Just hints) host (Just (show port))+  let sa = Socket.addrAddress i+  _ <- f fd sa+  return fd++-- | Convert 'Socket.Socket' to 'Tcp'.+socket_to_tcp :: Socket.Socket -> IO Tcp+socket_to_tcp fd = fmap Tcp (Socket.socketToHandle fd Io.ReadWriteMode)++-- | Create and initialise Tcp.+tcp_handle :: (Socket.Socket -> Socket.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+> import Sound.Osc.Time+> let t = openTcp "127.0.0.1" 57110+> let m1 = Packet.message "/dumpOsc" [Int32 1]+> let m2 = Packet.message "/g_new" [Int32 1]+> Fd.withTransport t (\fd -> let f = Fd.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2)+-}+openTcp :: String -> Int -> IO Tcp+openTcp = tcp_handle Socket.connect++-- | 'Socket.accept' connection at /s/ and run /f/.+tcp_server_f :: Socket.Socket -> (Tcp -> IO ()) -> IO ()+tcp_server_f s f = do+  (fd, _) <- Socket.accept s+  h <- socket_to_tcp fd+  f h++-- | A trivial 'Tcp' /Osc/ server.+tcp_server :: Int -> (Tcp -> IO ()) -> IO ()+tcp_server port f = do+  s <- tcp_socket Socket.bind Nothing port+  Socket.listen s 1+  let repeatM_ = sequence_ . repeat+  repeatM_ (tcp_server_f s f)

+ Sound/Osc/Transport/Fd/Udp.hs view

@@ -0,0 +1,119 @@+-- | 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 Data.ByteString as B {- bytestring -}+import qualified Data.ByteString.Lazy as BL {- bytestring -}+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.+newtype 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 data over Udp using 'C.send'.+udp_send_data :: Udp -> B.ByteString -> IO ()+udp_send_data (Udp fd) d = do+  let l = B.length d+  n <- C.send fd d+  when (n /= l) (error (show ("udp_send_data", l, n)))++-- | Send data over Udp using 'C.sendAll'.+udp_sendAll_data :: Udp -> B.ByteString -> IO ()+udp_sendAll_data (Udp fd) = C.sendAll fd++-- | Send packet over Udp.+udp_send_packet :: Udp -> Packet.PacketOf Packet.Message -> IO ()+udp_send_packet udp = udp_sendAll_data udp . Builder.encodePacket_strict++-- | Receive packet over Udp.+udp_recv_packet :: Udp -> IO (Packet.PacketOf Packet.Message)+udp_recv_packet (Udp fd) = fmap Binary.decodePacket_strict (C.recv fd 8192)++udp_recv_packet_or :: Udp -> IO (Either String Packet.Packet)+udp_recv_packet_or (Udp fd) = Binary.decodePacketOr . BL.fromStrict <$> 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 = udp_send_packet+  recvPacket = udp_recv_packet+  recvPacketOr = udp_recv_packet_or+  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+  let hints = N.defaultHints {N.addrFamily = N.AF_INET} -- localhost=ipv4+  i : _ <- N.getAddrInfo (Just hints) (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++> let u0 = udpServer "127.0.0.1" 57300+> t0 <- forkIO (Fd.withTransport u0 (\fd -> forever (Fd.recvMessage fd >>= print >> print "Received message, continuing")))+> killThread t0++> let u1 = openUdp "127.0.0.1" 57300+> Fd.withTransport u1 (\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.addrFamily = N.AF_INET -- localhost=ipv4+          , 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 to specified address using 'C.sendAllTo.+sendTo :: Udp -> Packet.PacketOf Packet.Message -> N.SockAddr -> IO ()+sendTo (Udp fd) p = C.sendAllTo fd (Builder.encodePacket_strict p)++-- | Recv variant to collect message source address.+recvFrom :: Udp -> IO (Packet.PacketOf Packet.Message, N.SockAddr)+recvFrom (Udp fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192)

+ Sound/Osc/Transport/Monad.hs view

@@ -0,0 +1,128 @@+-- | Monad class implementing an Open Sound Control transport.+module Sound.Osc.Transport.Monad where++import Control.Monad {- base -}+import Control.Monad.IO.Class {- base -}+import Data.List {- base -}+import Data.Maybe {- base -}++import qualified Control.Monad.Trans.Reader as R {- transformers -}++import qualified Sound.Osc.Datum as Datum {- hosc -}+import qualified Sound.Osc.Packet as Packet {- hosc -}+import qualified Sound.Osc.Transport.Fd as Fd {- 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.PacketOf Packet.Message -> m ()++-- | Receiver monad.+class Monad m => RecvOsc m where+  -- | Receive and decode an Osc packet.+  recvPacket :: m (Packet.PacketOf Packet.Message)++-- | 'DuplexOsc' is the union of 'SendOsc' and 'RecvOsc'.+class (SendOsc m, RecvOsc m) => DuplexOsc m++-- | 'Transport' is 'DuplexOsc' with a 'MonadIO' constraint.+class (DuplexOsc m, MonadIO m) => Transport m++-- | 'SendOsc' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => SendOsc (R.ReaderT t io) where+  sendPacket p = R.ReaderT (liftIO . flip Fd.sendPacket p)++-- | 'RecvOsc' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => RecvOsc (R.ReaderT t io) where+  recvPacket = R.ReaderT (liftIO . Fd.recvPacket)++-- | 'DuplexOsc' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => DuplexOsc (R.ReaderT t io)++-- | 'Transport' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => Transport (R.ReaderT t io)++-- | Transport connection.+type Connection t a = R.ReaderT t IO a++-- | Bracket Open Sound Control communication.+withTransport :: Fd.Transport t => IO t -> Connection t r -> IO r+withTransport u = Fd.withTransport u . R.runReaderT++-- | 'void' of 'withTransport'.+withTransport_ :: Fd.Transport t => IO t -> Connection t r -> IO ()+withTransport_ u = void . withTransport u++-- * 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.BundleOf Packet.Message -> m ()+sendBundle = sendPacket . Packet.Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (RecvOsc m) => m (Packet.BundleOf Packet.Message)+recvBundle = fmap Packet.packet_to_bundle recvPacket++-- | Variant of 'recvPacket' that runs 'packet_to_message'.+recvMessage :: (RecvOsc m) => m (Maybe Packet.Message)+recvMessage = fmap 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 = fmap Packet.packetMessages recvPacket++-- * Wait++{- | Wait for a 'Packet' where the supplied predicate is 'True',+discarding intervening packets.+-}+waitUntil :: (RecvOsc m) => (Packet.PacketOf Packet.Message -> Bool) -> m (Packet.PacketOf Packet.Message)+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.PacketOf Packet.Message -> Maybe a) -> m a+waitFor f = Wait.untilMaybe f recvPacket++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: RecvOsc m => m (Packet.PacketOf Packet.Message)+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.PacketOf Packet.Message)+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 fmap f (waitAddress s)++-- | Variant of 'waitReply' that runs 'messageDatum'.+waitDatum :: RecvOsc m => Packet.Address_Pattern -> m [Datum.Datum]+waitDatum = fmap Packet.messageDatum . waitReply

+ Sound/Osc/Wait.hs view

@@ -0,0 +1,18 @@+-- | Waiting (for replies).+module Sound.Osc.Wait where++-- * 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

+ contrib/LICENSE view

@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.

hosc.cabal view

@@ -1,40 +1,57 @@+Cabal-Version:     2.4 Name:              hosc-Version:           0.8+Version:           0.21.1 Synopsis:          Haskell Open Sound Control-Description:       hosc provides Sound.OpenSoundControl, a haskell-                   module implementing a subset of the Open Sound-                   Control byte protocol.-License:           GPL+Description:       Haskell library implementing the Open Sound Control protocol+License:           GPL-3.0-only+License-File:      contrib/LICENSE Category:          Sound-Copyright:         (c) Rohan Drape, 2006-2010-Author:            Rohan Drape-Maintainer:        rd@slavepianos.org+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2024+Author:            Rohan Drape, Stefan Kersten+Maintainer:        rd@rohandrape.net Stability:         Experimental-Homepage:          http://slavepianos.org/rd/?t=hosc-Tested-With:       GHC == 6.10.3+Homepage:          http://rohandrape.net/t/hosc+Tested-With:       GHC == 9.10.1 Build-Type:        Simple-Cabal-Version:     >= 1.6-Data-Files:        README-                   Help/timer.hs+Data-Files:        README.md  Library-  Build-Depends:   array,-                   base == 4.*,+  Build-Depends:   base >= 4.8 && < 5,+                   binary >= 0.7.2,+                   blaze-builder >= 0.3,                    bytestring,-                   binary,-                   network,-                   time-  GHC-Options:     -Wall -fwarn-tabs-  Exposed-modules: Sound.OpenSoundControl-                   Sound.OpenSoundControl.Byte-                   Sound.OpenSoundControl.Cast-                   Sound.OpenSoundControl.Coerce-                   Sound.OpenSoundControl.OSC-                   Sound.OpenSoundControl.Time-                   Sound.OpenSoundControl.Transport-                   Sound.OpenSoundControl.Transport.TCP-                   Sound.OpenSoundControl.Transport.UDP+                   network >= 2.3,+                   parsec,+                   safe,+                   time >= 1.5,+                   transformers+  Default-Language:Haskell2010+  GHC-Options:     -Wall -Wno-x-partial -Wno-incomplete-uni-patterns+  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.Text+                   Sound.Osc.Time+                   Sound.Osc.Time.System+                   Sound.Osc.Time.Thread+                   Sound.Osc.Time.Thread.MonadIO+                   Sound.Osc.Time.Timeout+                   Sound.Osc.Transport.Fd+                   Sound.Osc.Transport.Fd.Socket+                   Sound.Osc.Transport.Fd.Tcp+                   Sound.Osc.Transport.Fd.Udp+                   Sound.Osc.Transport.Monad+                   Sound.Osc.Wait  Source-Repository  head-  Type:            darcs-  Location:        http://slavepianos.org/~rd/sw/hosc/+  Type:            git+  Location:        https://gitlab.com/rd--/hosc