hosc 0.16 → 0.17

raw patch · 20 files changed

+313/−557 lines, 20 filesdep ~networkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• README +5/−6
• Sound/OSC/Coding/Byte.hs +22/−0
• Sound/OSC/Coding/Class.hs +0/−47
• Sound/OSC/Coding/Decode/Base.hs +2/−2
• Sound/OSC/Coding/Decode/Binary.hs +10/−10
• Sound/OSC/Coding/Encode/Builder.hs +18/−12
• Sound/OSC/Datum.hs +13/−13
• Sound/OSC/Datum/Datem.hs +0/−129
• Sound/OSC/Datum/Normalise.hs +0/−65
• Sound/OSC/Datum/Unpack.hs +0/−44
• Sound/OSC/Packet.hs +7/−7
• Sound/OSC/Packet/Class.hs +0/−30
• Sound/OSC/Packet/Coerce.hs +0/−13
• Sound/OSC/Time.hs +40/−28
• Sound/OSC/Transport/FD.hs +5/−10
• Sound/OSC/Transport/FD/TCP.hs +75/−36
• Sound/OSC/Transport/FD/UDP.hs +57/−36
• Sound/OSC/Transport/Monad.hs +46/−50
• Sound/OSC/Wait.hs +3/−3
• hosc.cabal +10/−16

@@ -9,22 +9,21 @@  - [hosc-json](?t=hosc-json): JSON text encoding of OSC -© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2017,+© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2018, [gpl][gpl]. with contributions by:  - [alex mclean][am] - [henning thielemann][ht] -see the [darcs][darcs] [history](?t=hosc&q=history) for details+see the [git](https://git-scm.com/) [history](?t=hosc&q=history) for details -[hosc]: http://rd.slavepianos.org/?t=hosc+[hosc]: http://rohandrape.net/?t=hosc [hs]: http://haskell.org/ [osc]: http://opensoundcontrol.org/-[hsc3]: http://rd.slavepianos.org/?t=hsc3+[hsc3]: http://rohandrape.net/?t=hsc3 [sc3]: http://audiosynth.com/-[rd]:  http://rd.slavepianos.org/+[rd]:  http://rohandrape.net/ [sk]: http://space.k-hornz.de/ [am]: http://yaxu.org/ [ht]: http://www.henning-thielemann.de/Research.html-[darcs]: http://darcs.net/ [gpl]: http://gnu.org/copyleft/

@@ -194,6 +194,18 @@  -- * IO +-- | 'decode_i8' of 'L.hGet'.+read_i8 :: Handle -> IO Int+read_i8 = fmap decode_i8 . flip L.hGet 1++-- | 'decode_i16' of 'L.hGet'.+read_i16 :: Handle -> IO Int+read_i16 = fmap decode_i16 . flip L.hGet 2++-- | 'decode_i32' of 'L.hGet'.+read_i32 :: Handle -> IO Int+read_i32 = fmap decode_i32 . flip L.hGet 4+ -- | 'decode_u32' of 'L.hGet'. read_u32 :: Handle -> IO Int read_u32 = fmap decode_u32 . flip L.hGet 4@@ -201,6 +213,16 @@ -- | 'decode_u32_le' of 'L.hGet'. read_u32_le :: Handle -> IO Int read_u32_le = fmap decode_u32_le . flip L.hGet 4++-- | 'decode_f32' of 'L.hGet'.+read_f32 :: Handle -> IO Float+read_f32 = fmap decode_f32 . flip L.hGet 4++-- | Read u8 length prefixed ASCII string (pascal string).+read_pstr :: Handle -> IO S.C.ByteString+read_pstr h = do+  n <- fmap decode_u8 (L.hGet h 1)+  fmap decode_str (L.hGet h n)  -- | 'L.hPut' of 'encode_u32'. write_u32 :: Handle -> Int -> IO ()

@@ -1,47 +0,0 @@--- | A type-class to provide coding operations to different data types---   using the same function names.-module Sound.OSC.Coding.Class where--import qualified Data.ByteString as Strict {- bytestring -}-import qualified Data.ByteString.Lazy as Lazy {- bytestring -}--import Sound.OSC.Packet {- hosc -}-import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -}-import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -}---- | Converting from and to binary packet representations.-class Coding a where-    encodePacket :: Packet -> a -- ^ Decode an OSC packet.-    decodePacket :: a -> Packet -- ^ Encode an OSC packet.--instance Coding Strict.ByteString where-    encodePacket = Builder.encodePacket_strict-    decodePacket = Binary.decodePacket_strict--instance Coding Lazy.ByteString where-    encodePacket = Builder.encodePacket-    decodePacket = Binary.decodePacket--{--{-# LANGUAGE FlexibleInstances #-}-import qualified Data.ByteString.Lazy.Char8 as Char8 {- bytestring -}-instance Coding String where-    encodePacket = Char8.unpack . encodePacket-    decodePacket = decodePacket . Char8.pack--}---- | 'encodePacket' '.' 'Packet_Message'.-encodeMessage :: Coding c => Message -> c-encodeMessage = encodePacket . Packet_Message---- | 'encodePacket' '.' 'Packet_Bundle'.-encodeBundle :: Coding c => Bundle -> c-encodeBundle = encodePacket . Packet_Bundle---- | 'packet_to_message' '.' 'decodePacket'.-decodeMessage :: Coding c => c -> Maybe Message-decodeMessage = packet_to_message . decodePacket---- | 'packet_to_bundle' '.' 'decodePacket'.-decodeBundle :: Coding c => c -> Bundle-decodeBundle = packet_to_bundle . decodePacket

@@ -1,5 +1,5 @@--- | Base-level decode function for OSC packets (slow).  For ordinary---   use see 'Sound.OSC.Coding.Decode.Binary'.+-- | 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

@@ -7,7 +7,7 @@     ,decodePacket_strict) where  import Control.Applicative {- base -}-import Control.Monad (when) {- base -}+import Control.Monad {- base -} import qualified Data.Binary.Get as G {- binary -} import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -} import qualified Data.ByteString.Char8 as S.C {- bytestring -}@@ -16,10 +16,10 @@ import Data.Int {- base -} import Data.Word {- base -} -import Sound.OSC.Coding.Byte {- hosc -}+import qualified Sound.OSC.Coding.Byte as Byte {- hosc -} import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Time {- hosc -}+import qualified Sound.OSC.Time as Time {- hosc -}  -- | Get a 32 bit integer in big-endian byte order. getInt32be :: G.Get Int32@@ -33,14 +33,14 @@ get_string :: G.Get String get_string = do     s <- G.getLazyByteStringNul-    G.skip (fromIntegral (align (B.length s + 1)))+    G.skip (fromIntegral (Byte.align (B.length s + 1)))     return $ C.unpack s  -- | Get an aligned OSC string. get_ascii :: G.Get ASCII get_ascii = do     s <- G.getLazyByteStringNul-    G.skip (fromIntegral (align (B.length s + 1)))+    G.skip (fromIntegral (Byte.align (B.length s + 1)))     return (S.C.pack (C.unpack s))  -- | Get binary data prefixed by byte count.@@ -49,7 +49,7 @@     b <- G.getLazyByteString (fromIntegral n)     if n /= fromIntegral (B.length b)         then fail "get_bytes: end of stream"-        else G.skip (fromIntegral (align n))+        else G.skip (fromIntegral (Byte.align n))     return b  -- | Get an OSC datum.@@ -62,7 +62,7 @@       'd' -> Double <$> I.getFloat64be       's' -> ASCII_String <$> get_ascii       'b' -> Blob   <$> (get_bytes =<< G.getWord32be)-      't' -> TimeStamp <$> ntpi_to_ntpr <$> G.getWord64be+      't' -> TimeStamp <$> Time.ntpi_to_ntpr <$> G.getWord64be       'm' -> do b0 <- G.getWord8                 b1 <- G.getWord8                 b2 <- G.getWord8@@ -95,9 +95,9 @@ -- | Get a bundle. Fail if bundle header is not found in packet. get_bundle :: G.Get Bundle get_bundle = do-    h <- G.getByteString (S.C.length bundleHeader_strict)-    when (h /= bundleHeader_strict) (fail "get_bundle: not a bundle")-    t <- ntpi_to_ntpr <$> G.getWord64be+    h <- G.getByteString (S.C.length Byte.bundleHeader_strict)+    when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle")+    t <- Time.ntpi_to_ntpr <$> G.getWord64be     ps <- get_message_seq     return $ Bundle t ps 

@@ -62,7 +62,7 @@             ,mconcat (map build_datum l)]  -- Encode an OSC 'Bundle'.-build_bundle_ntpi :: NTPi -> [Message] -> B.Builder+build_bundle_ntpi :: NTP64 -> [Message] -> B.Builder build_bundle_ntpi t l =     mconcat [B.fromLazyByteString Byte.bundleHeader             ,B.fromWord64be t@@ -75,27 +75,33 @@       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 #-} {-# INLINE encodePacket_strict #-} -{- | Encode an OSC 'Message'.+-- | Encode an OSC 'Packet'.+encodePacket :: Packet -> L.ByteString+encodePacket = B.toLazyByteString . build_packet -> let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]-> encodeMessage (Message "/g_free" [Int32 0]) == b+{- | Encode an OSC 'Message', ie. 'encodePacket' of 'Packet_Message'. +> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+> encodeMessage (Message "/g_free" [Int32 0]) == L.pack m+ -} encodeMessage :: Message -> L.ByteString-encodeMessage = B.toLazyByteString . build_packet . Packet_Message+encodeMessage = encodePacket . Packet_Message --- | Encode an OSC 'Bundle'.-encodeBundle :: Bundle -> L.ByteString-encodeBundle = B.toLazyByteString . build_packet . Packet_Bundle+{- | Encode an OSC 'Bundle', ie. 'encodePacket' of 'Packet_Bundle'. --- | Encode an OSC 'Packet'.-encodePacket :: Packet -> L.ByteString-encodePacket = B.toLazyByteString . build_packet+> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+> let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m+> encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b++-}+encodeBundle :: Bundle -> L.ByteString+encodeBundle = encodePacket . Packet_Bundle  -- | Encode an OSC 'Packet' to a strict 'S.ByteString'. encodePacket_strict :: Packet -> S.ByteString

@@ -6,11 +6,12 @@ import Data.Maybe {- base -} import Data.Word {- base -} import Numeric {- base -}+import Text.Read {- base -}  import qualified Data.ByteString.Lazy as Lazy {- bytestring -} import qualified Data.ByteString.Char8 as Char8 {- bytestring -} -import Sound.OSC.Time {- hosc -}+import qualified Sound.OSC.Time as Time {- hosc -}  -- * Datum @@ -50,10 +51,12 @@            | Double {d_double :: Double}            | ASCII_String {d_ascii_string :: ASCII}            | Blob {d_blob :: BLOB}-           | TimeStamp {d_timestamp :: Time} -- ie. NTPr+           | TimeStamp {d_timestamp :: Time.Time} -- ie. NTPr            | Midi {d_midi :: MIDI}              deriving (Eq,Read,Show) +-- * Datum types+ -- | List of required data types (tag,name). osc_types_required :: [(Datum_Type,String)] osc_types_required =@@ -110,10 +113,12 @@ datum_type_name :: Datum -> (Datum_Type,String) datum_type_name d = let c = datum_tag d in (c,osc_type_name_err c) +-- * Generalised element access+ -- | 'Datum' as 'Integral' if Int32 or Int64. -- -- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]--- > in map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]+-- > map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing] datum_integral :: Integral i => Datum -> Maybe i datum_integral d =     case d of@@ -124,7 +129,7 @@ -- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp. -- -- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]--- > in Data.Maybe.mapMaybe datum_floating d == replicate 5 (5::Double)+-- > mapMaybe datum_floating d == replicate 5 (5::Double) datum_floating :: Floating n => Datum -> Maybe n datum_floating d =     case d of@@ -135,6 +140,8 @@       TimeStamp n -> Just (realToFrac n)       _ -> Nothing +-- * Constructors+ -- | Type generalised Int32. -- -- > int32 (1::Int32) == int32 (1::Integer)@@ -181,7 +188,7 @@  -- | Message argument types are given by a descriptor. ----- > Char8.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",ifs"+-- > descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs" descriptor :: [Datum] -> ASCII descriptor l = Char8.pack (',' : map datum_tag l) @@ -208,7 +215,7 @@ -- | Pretty printer for 'Time'. -- -- > timePP (Just 4) (1/3) == "0.3333"-timePP :: FP_Precision -> Time -> String+timePP :: FP_Precision -> Time.Time -> String timePP = floatPP  -- | Pretty printer for vectors.@@ -240,13 +247,6 @@ datum_pp_typed fp d = datumPP fp d ++ ":" ++ snd (datum_type_name d)  -- * Parser---- | Variant of 'read'.-readMaybe :: (Read a) => String -> Maybe a-readMaybe s =-    case reads s of-      [(x, "")] -> Just x-      _ -> Nothing  -- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'. --

@@ -1,129 +0,0 @@--- | A class for translating to and from 'Datum'.-module Sound.OSC.Datum.Datem where--import qualified Data.ByteString.Lazy as Lazy {- bytestring -}-import qualified Data.ByteString.Char8 as Char8 {- bytestring -}-import Data.Int {- base -}-import Data.Maybe {- base -}-import Data.Word {- base -}--import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Time {- hosc -}--{- | Class for translating to and from 'Datum'.-     There are instances for the direct 'Datum' field types.--> d_put (1::Int32) == Int32 1-> d_put (1::Int64) == Int64 1-> d_put (1::Float) == Float 1-> d_put (1::Double) == Double 1-> d_put (Char8.pack "str") == ASCII_String (Char8.pack "str")-> d_put (Lazy.pack [37,37]) == Blob (blob_pack [37,37])-> d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)--There are also instances for standard Haskell types.--> d_put (1::Int) == Int64 1-> d_put (1::Integer) == Int64 1---}-class Datem a where-    d_put :: a -> Datum -- ^ Function to wrap value in 'Datum'.-    d_get :: Datum -> Maybe a -- ^ Function to extract value from 'Datum'.--instance Datem Int32 where-    d_put = Int32-    d_get d = case d of {Int32 x -> Just x;_ -> Nothing}--instance Datem Int64 where-    d_put = Int64-    d_get d = case d of {Int64 x -> Just x;_ -> Nothing}--instance Datem Int where-    d_put = Int64 . fromIntegral-    d_get = datum_integral--instance Datem Integer where-    d_put = Int64 . fromIntegral-    d_get = datum_integral--instance Datem Float where-    d_put = Float-    d_get d = case d of {Float x -> Just x;_ -> Nothing}--instance Datem Double where-    d_put = Double-    d_get d = case d of {Double x -> Just x;_ -> Nothing}--instance Datem Char8.ByteString where-    d_put = ASCII_String-    d_get d = case d of {ASCII_String x -> Just x;_ -> Nothing}--instance Datem Lazy.ByteString where-    d_put = Blob-    d_get d = case d of {Blob x -> Just x;_ -> Nothing}--instance Datem MIDI where-    d_put = Midi-    d_get d = case d of {Midi x -> Just x;_ -> Nothing}---- | Error variant of 'd_get'.-d_get_err :: Datem a => Datum -> a-d_get_err = fromMaybe (error "d_get") . d_get---- * Type specialised---- | Type specialised 'd_get'.------ > map datum_int32 [Int32 1,Float 1] == [Just 1,Nothing]-datum_int32 :: Datum -> Maybe Int32-datum_int32 = d_get---- | Type specialised 'd_get'.-datum_int64 :: Datum -> Maybe Int64-datum_int64 = d_get---- | Type specialised 'd_get'.-datum_float :: Datum -> Maybe Float-datum_float = d_get---- | Type specialised 'd_get'.-datum_double :: Datum -> Maybe Double-datum_double = d_get---- | Type specialised 'd_get'.------ > datum_ascii (d_put (Char8.pack "string")) == Just (Char8.pack "string")-datum_ascii :: Datum -> Maybe ASCII-datum_ascii = d_get---- | 'Char8.unpack' of 'd_get'.------ > datum_string (d_put (Char8.pack "string")) == Just "string"--- > map datum_string [string "string",Int32 5] == [Just "string",Nothing]-datum_string :: Datum -> Maybe String-datum_string = fmap Char8.unpack . datum_ascii---- | Type specialised 'd_get'.-datum_blob :: Datum -> Maybe Lazy.ByteString-datum_blob = d_get---- | 'Maybe' variant of 'd_timestamp'.-datum_timestamp :: Datum -> Maybe Time-datum_timestamp d = case d of {TimeStamp x -> Just x;_ -> Nothing}---- | Type specialised 'd_get'.-datum_midi :: Datum -> Maybe MIDI-datum_midi = d_get---- | 'Datum' as sequence of 'Word8' if 'ASCII_String', 'Blob' or 'Midi'.------ > let d = [string "5",Blob (Lazy.pack [53]),midi (0x00,0x90,0x40,0x60)]--- > in Data.Maybe.mapMaybe datum_sequence d == [[53],[53],[0,144,64,96]]-datum_sequence :: Datum -> Maybe [Word8]-datum_sequence d =-    case d of-      ASCII_String s -> Just (map (fromIntegral . fromEnum) (Char8.unpack s))-      Blob s -> Just (Lazy.unpack s)-      Midi (MIDI p q r s) -> Just [p,q,r,s]-      _ -> Nothing

@@ -1,65 +0,0 @@--- | Datum normalisation.-module Sound.OSC.Datum.Normalise where--import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet as O {- hosc -}---- | Lift 'O.Int32' to 'O.Int64' and 'O.Float' to 'O.Double'.------ > map normalise_datum [Int32 1,Float 1] == [Int64 1,Double 1]-normalise_datum :: Datum -> Datum-normalise_datum d =-    case d of-      Int32 n -> Int64 (fromIntegral n)-      Float n -> Double (realToFrac n)-      _ -> d---- | A normalised 'O.Message' has only 'O.Int64' and 'O.Double'--- numerical values.------ > let m = message "/m" [Int32 0,Float 0]--- > in normalise_message m == message "/m" [Int64 0,Double 0]-normalise_message :: Message -> Message-normalise_message = message_coerce normalise_datum---- | A normalised 'O.Bundle' has only 'O.Int64' and 'O.Double'--- numerical values.-normalise_bundle :: Bundle -> Bundle-normalise_bundle = bundle_coerce normalise_datum---- * Coercion---- | Map a normalising function over datum at an OSC 'Message'.-message_coerce :: (Datum -> Datum) -> Message -> Message-message_coerce f (Message s xs) = Message s (map f xs)---- | Map a normalising function over datum at an OSC 'Bundle'.-bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle-bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)---- * Promotion---- | Coerce 'Int32', 'Int64' and 'Float' to 'Double'.------ > map datum_promote [Int32 5,Float 5] == [Double 5,Double 5]-datum_promote :: Datum -> Datum-datum_promote d =-    case d of-      Int32 n -> Double (fromIntegral n)-      Int64 n -> Double (fromIntegral n)-      Float n -> Double (realToFrac n)-      _ -> d---- | 'O.Datum' as 'O.Int64' if 'O.Int32', 'O.Int64', 'O.Float' or--- 'O.Double'.------ > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5,string "5"]--- > in map datum_floor d == [Int64 5,Int64 5,Int64 5,Int64 5,string "5"]-datum_floor :: Datum -> Datum-datum_floor d =-    case d of-      Int32 x -> Int64 (fromIntegral x)-      Float x -> Int64 (fromInteger (floor x))-      Double x -> Int64 (fromInteger (floor x))-      _ -> d-

@@ -1,44 +0,0 @@--- | Unpack 'Datum' lists into tuples.-module Sound.OSC.Datum.Unpack where--import Data.Int {- base -}--import Sound.OSC.Datum {- hosc -}---- * S = strict---- | Strictly unpack to (s,f).-unpackS_sf :: [Datum] -> Maybe (String,Float)-unpackS_sf dat =-    case dat of-      [ASCII_String d1,Float d2] -> Just (ascii_to_string d1,d2)-      _ -> Nothing---- | Strictly unpack to (i,f).-unpackS_if :: [Datum] -> Maybe (Int32,Float)-unpackS_if dat =-    case dat of-      [Int32 d1,Float d2] -> Just (d1,d2)-      _ -> Nothing---- * C = coerce---- | Casting unpack to (s,d).-unpackC_sf :: [Datum] -> Maybe (String,Double)-unpackC_sf dat =-    case dat of-      [ASCII_String d1,d2] ->-        case datum_floating d2 of-          Just d2' -> Just (ascii_to_string d1,d2')-          Nothing -> Nothing-      _ -> Nothing---- | Casting unpack to (i,d).-unpackC_if :: [Datum] -> Maybe (Int,Double)-unpackC_if dat =-    case dat of-      [d1,d2] ->-          case (datum_integral d1,datum_floating d2) of-            (Just d1',Just d2') -> Just (d1',d2')-            _ -> Nothing-      _ -> Nothing

@@ -8,12 +8,12 @@  -- * Message --- | OSC address pattern.  This is strictly an ASCII value, but it is--- very common to pattern match on addresses and matching on--- 'C.ByteString' requires @OverloadedStrings@.+-- | OSC address pattern.  This is strictly an ASCII value, however it+--   is very common to pattern match on addresses and matching on+--   'C.ByteString' requires @OverloadedStrings@. type Address_Pattern = String --- | An OSC message.+-- | An OSC message, an 'Address_Pattern' and a sequence of 'Datum'. data Message = Message {messageAddress :: Address_Pattern                        ,messageDatum :: [Datum]}                deriving (Eq,Read,Show)@@ -28,7 +28,7 @@  -- * Bundle --- | An OSC bundle.+-- | An OSC bundle, a 'Time' and a sequence of 'Message's. data Bundle = Bundle {bundleTime :: Time                      ,bundleMessages :: [Message]}               deriving (Eq,Read,Show)@@ -52,11 +52,11 @@             | Packet_Bundle {packetBundle :: Bundle}               deriving (Eq,Read,Show) --- | 'Packet_Bundle' '.' 'bundle'.+-- | 'Packet_Bundle' of 'bundle'. p_bundle :: Time -> [Message] -> Packet p_bundle t = Packet_Bundle . bundle t --- | 'Packet_Message' '.' 'message'.+-- | 'Packet_Message' of 'message'. p_message :: Address_Pattern -> [Datum] -> Packet p_message a = Packet_Message . message a 

@@ -1,30 +0,0 @@--- | Typeclass for encoding and decoding OSC packets.-module Sound.OSC.Packet.Class where--import Sound.OSC.Coding.Class {- hosc -}-import Sound.OSC.Packet {- hosc -}---- | A type-class for values that can be translated to and from OSC 'Packet's.-class OSC o where-    toPacket :: o -> Packet -- ^ Translation to 'Packet'.-    fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.--instance OSC Message where-    toPacket = Packet_Message-    fromPacket = packet_to_message--instance OSC Bundle where-    toPacket = Packet_Bundle-    fromPacket = Just . packet_to_bundle--instance OSC Packet where-    toPacket = id-    fromPacket = Just---- | 'encodePacket' '.' 'toPacket'.-encodeOSC :: (Coding c,OSC o) => o -> c-encodeOSC = encodePacket . toPacket---- | 'fromPacket' '.' 'decodePacket'.-decodeOSC :: (Coding c,OSC o) => c -> Maybe o-decodeOSC = fromPacket . decodePacket

@@ -1,13 +0,0 @@--- | Packet coercion.-module Sound.OSC.Packet.Coerce where--import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet as O {- hosc -}---- | Map a normalising function over datum at an OSC 'Message'.-message_coerce :: (Datum -> Datum) -> Message -> Message-message_coerce f (Message s xs) = Message s (map f xs)---- | Map a normalising function over datum at an OSC 'Bundle'.-bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle-bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)

@@ -1,5 +1,5 @@ -- | OSC related timing functions.---   OSC timestamps are @NTP@ values, <http://ntp.org/>.+--   OSC timestamps are 64-bit @NTP@ values, <http://ntp.org/>. module Sound.OSC.Time where  import Control.Concurrent {- base -}@@ -12,39 +12,46 @@  -- * Temporal types --- | Type for integer (binary) representation of @NTP@ time.-type NTPi = Word64+-- | Type for binary (integeral) representation of a 64-bit @NTP@ timestamp (ie. @ntpi@).+--   The NTP epoch is January 1, 1900.+--   NTPv4 also includes a 128-bit format, which is not used by OSC.+type NTP64 = Word64  -- | @NTP@ time in real-valued (fractional) form (ie. @ntpr@).+--   This is the primary form of timestamp used by hosc. type Time = Double  -- | Constant indicating a bundle to be executed immediately.+--   It has the NTP64 representation of @1@. immediately :: Time immediately = 1 / 2^(32::Int) --- | @Unix/Posix@ epoch time in real-valued (fractional) form.+-- | @Unix/Posix@ time in real-valued (fractional) form.+--   The Unix/Posix epoch is January 1, 1970. type UT = Double  -- * Time conversion  -- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp. --+-- > ntpr_to_ntpi immediately == 1 -- > fmap ntpr_to_ntpi time-ntpr_to_ntpi :: RealFrac n => n -> NTPi-ntpr_to_ntpi t = round (t * 2^(32::Int))+ntpr_to_ntpi :: RealFrac n => n -> NTP64+ntpr_to_ntpi t = round (t * (2 ^ (32::Int)))  -- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.-ntpi_to_ntpr :: Fractional n => NTPi -> n+ntpi_to_ntpr :: Fractional n => NTP64 -> n ntpi_to_ntpr t = fromIntegral t / 2^(32::Int)  -- | Difference (in seconds) between /NTP/ and /UT/ epochs. -- -- > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567+-- > 25567 `div` 365 == 70 ntp_ut_epoch_diff :: Num n => n ntp_ut_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60  -- | Convert a 'UT' timestamp to an 'NTPi' timestamp.-ut_to_ntpi :: UT -> NTPi+ut_to_ntpi :: UT -> NTP64 ut_to_ntpi t = ntpr_to_ntpi (t + ntp_ut_epoch_diff)  -- | Convert @Unix/Posix@ to @NTP@.@@ -56,7 +63,7 @@ ntpr_to_ut = (+) (negate ntp_ut_epoch_diff)  -- | Convert 'NTPi' to @Unix/Posix@.-ntpi_to_ut :: NTPi -> UT+ntpi_to_ut :: NTP64 -> UT ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr  -- | Convert 'Time' to 'T.POSIXTime'.@@ -82,24 +89,26 @@  -- * Clock operations --- | Read current real-valued @NTP@ timestamp.------ > do {ct <- fmap utc_to_ut T.getCurrentTime--- >    ;pt <- fmap realToFrac T.getPOSIXTime--- >    ;print (pt - ct,pt - ct < 1e-5)}+{- | Read current real-valued @NTP@ timestamp.++> get_ct = fmap utc_to_ut T.getCurrentTime+> get_pt = fmap realToFrac T.getPOSIXTime+> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)+> print (pt - ct,pt - ct < 1e-5)++-} time :: MonadIO m => m Time time = liftIO (fmap posixtime_to_ntpr T.getPOSIXTime)  -- * Thread operations. --- | The 'pauseThread' limit (in seconds).  Values larger than this--- require a different thread delay mechanism, see 'sleepThread'.  The--- value is the number of microseconds in @maxBound::Int@.+-- | 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'.+-- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'. pauseThread :: (MonadIO m,RealFrac n) => n -> m () pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6)))) @@ -107,8 +116,7 @@ wait :: MonadIO m => Double -> m () wait = pauseThread --- | Pause current thread until the given 'Time', see--- 'pauseThreadLimit'.+-- | Pause current thread until the given 'Time', see 'pauseThreadLimit'. pauseThreadUntil :: MonadIO m => Time -> m () pauseThreadUntil t = pauseThread . (t -) =<< time @@ -121,15 +129,14 @@          in pauseThread n >> sleepThread (n - n')     else pauseThread n --- | Sleep current thread until the given 'Time'.  Divides long sleeps--- into parts smaller than 'pauseThreadLimit'.+-- | Sleep current thread until the given 'Time'.+--   Divides long sleeps into parts smaller than 'pauseThreadLimit'. sleepThreadUntil :: MonadIO m => Time -> m () sleepThreadUntil t = sleepThread . (t -) =<< time  -- * Pretty printing --- | Detailed 37-character ISO 8601 format, including fractional--- seconds and '+0000' suffix.+-- | Detailed 37-character ISO 8601 format, including fractional seconds and '+0000' suffix. iso_8601_fmt :: String iso_8601_fmt = "%Y-%m-%dT%H:%M:%S,%q+0000" @@ -142,7 +149,7 @@ -- | UTC time in 'iso_8601_fmt'. -- -- > tm <- fmap (utctime_to_iso_8601 . T.posixSecondsToUTCTime) T.getPOSIXTime--- > (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4])+-- > (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4]) == (37,37,37) utctime_to_iso_8601 :: T.UTCTime -> String utctime_to_iso_8601 = T.formatTime T.defaultTimeLocale iso_8601_fmt @@ -152,18 +159,23 @@ -- > import System.Process {- process -} -- > rawSystem "date" ["-d",tm] ----- > ntpr_to_iso_8601 (ntpi_to_ntpr 15708783354150518784)+-- > t = 15708783354150518784+-- > s = "2015-11-26T00:22:19,366058349609+0000"+-- > ntpr_to_iso_8601 (ntpi_to_ntpr t) == s ntpr_to_iso_8601 :: Time -> String ntpr_to_iso_8601 = utctime_to_iso_8601 . T.posixSecondsToUTCTime . ntpr_to_posixtime  -- | 'Time' of ISO 8601. ----- > fmap ntpr_to_ntpi (iso_8601_to_ntpr "2015-11-26T00:22:19,366058349609+0000")+-- > t = 15708783354150518784+-- > s = "2015-11-26T00:22:19,366058349609+0000"+-- > fmap ntpr_to_ntpi (iso_8601_to_ntpr s) == Just t iso_8601_to_ntpr :: String -> Maybe Time iso_8601_to_ntpr = fmap (posixtime_to_ntpr . T.utcTimeToPOSIXSeconds) . iso_8601_to_utctime  -- | Alias for 'ntpr_to_iso_8601'. --+-- > time_pp immediately == "1900-01-01T00:00:00,000000000000+0000" -- > fmap time_pp time time_pp :: Time -> String time_pp = ntpr_to_iso_8601

@@ -7,13 +7,12 @@  import Sound.OSC.Datum {- hosc -} import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Packet.Class {- 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.-   sendOSC :: OSC o => t -> o -> IO ()+   sendPacket :: t -> Packet -> IO ()    -- | Receive and decode an OSC packet.    recvPacket :: t -> IO Packet    -- | Close an existing connection.@@ -25,19 +24,15 @@  -- * Send --- | Type restricted synonym for 'sendOSC'.+-- | 'sendPacket' of 'Packet_Message'. sendMessage :: Transport t => t -> Message -> IO ()-sendMessage = sendOSC+sendMessage t = sendPacket t . Packet_Message --- | Type restricted synonym for 'sendOSC'.+-- | 'sendPacket' of 'Packet_Bundle'. sendBundle :: Transport t => t -> Bundle -> IO ()-sendBundle = sendOSC+sendBundle t = sendPacket t . Packet_Bundle  -- * Receive---- | Variant of 'recvPacket' that runs 'fromPacket'.-recvOSC :: (Transport t,OSC o) => t -> IO (Maybe o)-recvOSC = fmap fromPacket . recvPacket  -- | Variant of 'recvPacket' that runs 'packet_to_bundle'. recvBundle :: (Transport t) => t -> IO Bundle

@@ -1,54 +1,93 @@ -- | OSC over TCP implementation. module Sound.OSC.Transport.FD.TCP where +import qualified Control.Exception as Exception {- base -} import qualified Data.ByteString.Lazy as B {- bytestring -}-import Control.Monad {- base -}-import qualified Network as N {- network -}-import System.IO {- base -}+import qualified Network.Socket as N {- network -}+import qualified System.IO as IO {- base -} -import Sound.OSC.Coding.Class {- hosc -}-import Sound.OSC.Coding.Byte {- hosc -}-import Sound.OSC.Transport.FD {- hosc -}-import Sound.OSC.Packet.Class {- hosc -}+import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -}+import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -}+import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}+import qualified Sound.OSC.Packet as Packet {- hosc -}+import qualified Sound.OSC.Transport.FD as FD {- hosc -}  -- | The TCP transport handle data type.-data TCP = TCP {tcpHandle :: Handle}+data TCP = TCP {tcpHandle :: IO.Handle} +-- | Send packet over TCP.+tcp_send_packet :: TCP -> Packet.Packet -> IO ()+tcp_send_packet (TCP fd) p = do+  let b = Builder.encodePacket p+      n = fromIntegral (B.length b)+  B.hPut fd (B.append (Byte.encode_u32 n) b)+  IO.hFlush fd++-- | Receive packet over TCP.+tcp_recv_packet :: TCP -> IO Packet.Packet+tcp_recv_packet (TCP fd) = do+  b0 <- B.hGet fd 4+  b1 <- B.hGet fd (fromIntegral (Byte.decode_u32 b0))+  return (Binary.decodePacket b1)++-- | Close TCP.+tcp_close :: TCP -> IO ()+tcp_close = IO.hClose . tcpHandle+ -- | 'TCP' is an instance of 'Transport'.-instance Transport TCP where-   sendOSC (TCP fd) msg =-      do let b = encodeOSC msg-             n = fromIntegral (B.length b)-         B.hPut fd (B.append (encode_u32 n) b)-         hFlush fd-   recvPacket (TCP fd) =-      do b0 <- B.hGet fd 4-         b1 <- B.hGet fd (fromIntegral (decode_u32 b0))-         return (decodePacket b1)-   close (TCP fd) = hClose fd+instance FD.Transport TCP where+   sendPacket = tcp_send_packet+   recvPacket = tcp_recv_packet+   close = tcp_close +-- | Bracket UDP communication.+with_tcp :: IO TCP -> (TCP -> IO t) -> IO t+with_tcp u = Exception.bracket u tcp_close++-- | Create and initialise TCP socket.+tcp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> Maybe String -> Int -> IO N.Socket+tcp_socket f host port = do+  fd <- N.socket N.AF_INET N.Stream 0+  i:_ <- N.getAddrInfo Nothing host (Just (show port))+  let sa = N.addrAddress i+  _ <- f fd sa+  return fd++-- | Convert 'N.Socket' to 'TCP'.+socket_to_tcp :: N.Socket -> IO TCP+socket_to_tcp fd = fmap TCP (N.socketToHandle fd IO.ReadWriteMode)++-- | Create and initialise TCP.+tcp_handle :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO TCP+tcp_handle f host port = tcp_socket f (Just host) port >>= socket_to_tcp+ {- | Make a 'TCP' connection. -> import Sound.OSC.Core-> import Sound.OSC.Transport.FD-> import Sound.OSC.Transport.FD.TCP+> import Sound.OSC.Datum {- hosc -}+> import Sound.OSC.Time {- hosc -} > let t = openTCP "127.0.0.1" 57110-> let m1 = message "/dumpOSC" [Int32 1]-> let m2 = message "/g_new" [Int32 1]-> withTransport t (\fd -> let f = sendMessage fd in f m1 >> f m2)+> 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 host =-    liftM TCP .-    N.connectTo host .-    N.PortNumber .-    fromIntegral+openTCP = tcp_handle N.connect +-- | 'N.accept' connection at /s/ and run /f/.+tcp_server_f :: N.Socket -> (TCP -> IO ()) -> IO ()+tcp_server_f s f = do+  (fd, _) <- N.accept s+  h <- socket_to_tcp fd+  f h++-- | 'sequence_' of 'repeat'.+repeatM_ :: (Monad m) => m a -> m ()+repeatM_ = sequence_ . repeat+ -- | A trivial 'TCP' /OSC/ server.-tcpServer' :: Int -> (TCP -> IO ()) -> IO ()-tcpServer' p f = do-  s <- N.listenOn (N.PortNumber (fromIntegral p))-  (sequence_ . repeat) (do (fd, _, _) <- N.accept s-                           f (TCP fd)-                           return ())+tcp_server :: Int -> (TCP -> IO ()) -> IO ()+tcp_server port f = do+  s <- tcp_socket N.bind Nothing port+  N.listen s 1+  repeatM_ (tcp_server_f s f)

@@ -1,35 +1,52 @@ -- | OSC over UDP implementation. module Sound.OSC.Transport.FD.UDP where +import Control.Exception {- base -} import Control.Monad {- base -}+import Data.Bifunctor {- base -} import qualified Network.Socket as N {- network -} import qualified Network.Socket.ByteString as C {- network -} -import Sound.OSC.Coding.Class-import Sound.OSC.Packet-import Sound.OSC.Packet.Class-import Sound.OSC.Transport.FD+import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -}+import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -}+import qualified Sound.OSC.Packet as Packet {- hosc -}+import qualified Sound.OSC.Transport.FD as FD {- hosc -}  -- | The UDP transport handle data type. data UDP = UDP {udpSocket :: N.Socket}  -- | Return the port number associated with the UDP socket. udpPort :: Integral n => UDP -> IO n-udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)+udpPort = fmap fromIntegral . N.socketPort . udpSocket --- | 'UDP' is an instance of 'Transport'.-instance Transport UDP where-   -- C.L.send is not implemented for W32-   sendOSC (UDP fd) msg = void (C.send fd (encodeOSC msg))-   recvPacket (UDP fd) = liftM decodePacket (C.recv fd 8192)-   close (UDP fd) = N.close fd+-- | Send packet over UDP.+upd_send_packet :: UDP -> Packet.Packet -> IO ()+upd_send_packet (UDP fd) p = void (C.send fd (Builder.encodePacket_strict p)) +-- | Receive packet over UDP.+udp_recv_packet :: UDP -> IO Packet.Packet+udp_recv_packet (UDP fd) = liftM Binary.decodePacket_strict (C.recv fd 8192)++-- | Close UDP.+udp_close :: UDP -> IO ()+udp_close (UDP fd) = N.close fd++-- | 'UDP' is an instance of 'FD.Transport'.+instance FD.Transport UDP where+   sendPacket = upd_send_packet+   recvPacket = udp_recv_packet+   close = udp_close++-- | Bracket UDP communication.+with_udp :: IO UDP -> (UDP -> IO t) -> IO t+with_udp u = bracket u udp_close+ -- | Create and initialise UDP socket. udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO UDP udp_socket f host port = do   fd <- N.socket N.AF_INET N.Datagram 0-  a <- N.inet_addr host-  let sa = N.SockAddrInet (fromIntegral port) a+  i:_ <- N.getAddrInfo Nothing (Just host) (Just (show port))+  let sa = N.addrAddress i   f fd sa   return (UDP fd) @@ -42,35 +59,39 @@ get_udp_opt k (UDP s) = N.getSocketOption s k  -- | Make a 'UDP' connection.------ > let t = openUDP "127.0.0.1" 57110--- > in withTransport t (\fd -> recvT 0.5 fd >>= print) openUDP :: String -> Int -> IO UDP openUDP = udp_socket N.connect--- N.setSocketOption fd N.RecvTimeOut 1000 --- | Trivial 'UDP' server socket.------ > import Control.Concurrent------ > let {f fd = forever (recvMessage fd >>= print)--- >     ;t = udpServer "127.0.0.1" 57300}--- > in void (forkIO (withTransport t f))------ > let t = openUDP "127.0.0.1" 57300--- > in withTransport t (\fd -> sendMessage fd (message "/n" []))+{- | Trivial 'UDP' server socket.++> import Control.Concurrent {- base -}++> let t0 = udpServer "127.0.0.1" 57300+> forkIO (FD.withTransport t0 (\fd -> forever (FD.recvMessage fd >>= print)))++> let t1 = openUDP "127.0.0.1" 57300+> FD.withTransport t1 (\fd -> FD.sendMessage fd (Packet.message "/n" []))+-} udpServer :: String -> Int -> IO UDP udpServer = udp_socket N.bind +-- | Variant of 'udpServer' that doesn't require the host address.+udp_server :: Int -> IO UDP+udp_server p = do+  let hints =+        N.defaultHints+        {N.addrFlags = [N.AI_PASSIVE,N.AI_NUMERICSERV]+        ,N.addrSocketType = N.Datagram}+  a:_ <- N.getAddrInfo (Just hints) Nothing (Just (show p))+  s <- N.socket (N.addrFamily a) (N.addrSocketType a) (N.addrProtocol a)+  N.setSocketOption s N.ReuseAddr 1+  N.bind s (N.addrAddress a)+  return (UDP s)+ -- | Send variant to send to specified address.-sendTo :: OSC o => UDP -> o -> N.SockAddr -> IO ()-sendTo (UDP fd) o a = do-  -- C.L.sendTo does not exist-  void (C.sendTo fd (encodeOSC o) a)+sendTo :: UDP -> Packet.Packet -> N.SockAddr -> IO ()+sendTo (UDP fd) p = void . C.sendTo fd (Builder.encodePacket_strict p)  -- | Recv variant to collect message source address.-recvFrom :: UDP -> IO (Packet, N.SockAddr)-recvFrom (UDP fd) = do-  -- C.L.recvFrom does not exist-  (s,a) <- C.recvFrom fd 8192-  return (decodePacket s,a)+recvFrom :: UDP -> IO (Packet.Packet, N.SockAddr)+recvFrom (UDP fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192)

@@ -1,123 +1,119 @@ -- | Monad class implementing an Open Sound Control transport. module Sound.OSC.Transport.Monad where -import Control.Monad (liftM) {- base -}-import Control.Monad.Trans.Reader {- transformers -}-import Control.Monad.IO.Class as M {- transformers -}+import Control.Monad {- base -} import Data.List {- base -} import Data.Maybe {- base -} -import Sound.OSC.Datum {- hosc -}-import qualified Sound.OSC.Transport.FD as T {- hosc -}-import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Packet.Class {- hosc -}-import Sound.OSC.Wait {- hosc -}+import qualified Control.Monad.Trans.Reader as R {- transformers -}+import qualified Control.Monad.IO.Class as M {- transformers -} +import qualified Sound.OSC.Datum as Datum {- hosc -}+import qualified Sound.OSC.Transport.FD as FD {- hosc -}+import qualified Sound.OSC.Packet as Packet {- hosc -}+import qualified Sound.OSC.Wait as Wait {- hosc -}+ -- | Sender monad. class Monad m => SendOSC m where    -- | Encode and send an OSC packet.-   sendOSC :: OSC o => o -> m ()+   sendPacket :: Packet.Packet -> m ()  -- | Receiver monad. class Monad m => RecvOSC m where    -- | Receive and decode an OSC packet.-   recvPacket :: m Packet+   recvPacket :: m Packet.Packet  -- | 'DuplexOSC' is the union of 'SendOSC' and 'RecvOSC'. class (SendOSC m,RecvOSC m) => DuplexOSC m where  -- | 'Transport' is 'DuplexOSC' with a 'MonadIO' constraint.-class (DuplexOSC m,MonadIO m) => Transport m where+class (DuplexOSC m,M.MonadIO m) => Transport m where  -- | 'SendOSC' over 'ReaderT'.-instance (T.Transport t,MonadIO io) => SendOSC (ReaderT t io) where-   sendOSC o = ReaderT (M.liftIO . flip T.sendOSC o)+instance (FD.Transport t,M.MonadIO io) => SendOSC (R.ReaderT t io) where+   sendPacket p = R.ReaderT (M.liftIO . flip FD.sendPacket p)  -- | 'RecvOSC' over 'ReaderT'.-instance (T.Transport t,MonadIO io) => RecvOSC (ReaderT t io) where-   recvPacket = ReaderT (M.liftIO . T.recvPacket)+instance (FD.Transport t,M.MonadIO io) => RecvOSC (R.ReaderT t io) where+   recvPacket = R.ReaderT (M.liftIO . FD.recvPacket)  -- | 'DuplexOSC' over 'ReaderT'.-instance (T.Transport t,MonadIO io) => DuplexOSC (ReaderT t io) where+instance (FD.Transport t,M.MonadIO io) => DuplexOSC (R.ReaderT t io) where  -- | 'Transport' over 'ReaderT'.-instance (T.Transport t,MonadIO io) => Transport (ReaderT t io) where+instance (FD.Transport t,M.MonadIO io) => Transport (R.ReaderT t io) where  -- | Transport connection.-type Connection t a = ReaderT t IO a+type Connection t a = R.ReaderT t IO a  -- | Bracket Open Sound Control communication.-withTransport :: T.Transport t => IO t -> Connection t a -> IO a-withTransport u = T.withTransport u . runReaderT+withTransport :: FD.Transport t => IO t -> Connection t a -> IO a+withTransport u = FD.withTransport u . R.runReaderT  -- * Send  -- | Type restricted synonym for 'sendOSC'.-sendMessage :: SendOSC m => Message -> m ()-sendMessage = sendOSC+sendMessage :: SendOSC m => Packet.Message -> m ()+sendMessage = sendPacket . Packet.Packet_Message  -- | Type restricted synonym for 'sendOSC'.-sendBundle :: SendOSC m => Bundle -> m ()-sendBundle = sendOSC+sendBundle :: SendOSC m => Packet.Bundle -> m ()+sendBundle = sendPacket . Packet.Packet_Bundle  -- * Receive --- | Variant of 'recvPacket' that runs 'fromPacket'.-recvOSC :: (RecvOSC m,OSC o) => m (Maybe o)-recvOSC = liftM fromPacket recvPacket- -- | Variant of 'recvPacket' that runs 'packet_to_bundle'.-recvBundle :: (RecvOSC m) => m Bundle-recvBundle = liftM packet_to_bundle recvPacket+recvBundle :: (RecvOSC m) => m Packet.Bundle+recvBundle = liftM Packet.packet_to_bundle recvPacket  -- | Variant of 'recvPacket' that runs 'packet_to_message'.-recvMessage :: (RecvOSC m) => m (Maybe Message)-recvMessage = liftM packet_to_message recvPacket+recvMessage :: (RecvOSC m) => m (Maybe Packet.Message)+recvMessage = liftM Packet.packet_to_message recvPacket  -- | Erroring variant.-recvMessage_err :: RecvOSC m => m Message+recvMessage_err :: RecvOSC m => m Packet.Message recvMessage_err = fmap (fromMaybe (error "recvMessage")) recvMessage  -- | Variant of 'recvPacket' that runs 'packetMessages'.-recvMessages :: (RecvOSC m) => m [Message]-recvMessages = liftM packetMessages recvPacket+recvMessages :: (RecvOSC m) => m [Packet.Message]+recvMessages = liftM Packet.packetMessages recvPacket  -- * Wait  -- | Wait for a 'Packet' where the supplied predicate is 'True', -- discarding intervening packets.-waitUntil :: (RecvOSC m) => (Packet -> Bool) -> m Packet-waitUntil f = untilPredicate f recvPacket+waitUntil :: (RecvOSC m) => (Packet.Packet -> Bool) -> m Packet.Packet+waitUntil f = Wait.untilPredicate f recvPacket  -- | Wait for a 'Packet' where the supplied function does not give -- 'Nothing', discarding intervening packets.-waitFor :: (RecvOSC m) => (Packet -> Maybe a) -> m a-waitFor f = untilMaybe f recvPacket+waitFor :: (RecvOSC m) => (Packet.Packet -> Maybe a) -> m a+waitFor f = Wait.untilMaybe f recvPacket  -- | 'waitUntil' 'packet_is_immediate'.-waitImmediate :: RecvOSC m => m Packet-waitImmediate = waitUntil packet_is_immediate+waitImmediate :: RecvOSC m => m Packet.Packet+waitImmediate = waitUntil Packet.packet_is_immediate  -- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or -- immediate mode 'Bundle' with one element.-waitMessage :: RecvOSC m => m Message-waitMessage = waitFor packet_to_message+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 => Address_Pattern -> m Packet+waitAddress :: RecvOSC m => Packet.Address_Pattern -> m Packet.Packet waitAddress s =-    let f o = if packet_has_address s o then Just o else Nothing+    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 => Address_Pattern -> m Message+waitReply :: RecvOSC m => Packet.Address_Pattern -> m Packet.Message waitReply s =     let f = fromMaybe (error "waitReply: message not located?") .-            find (message_has_address s) .-            packetMessages+            find (Packet.message_has_address s) .+            Packet.packetMessages     in liftM f (waitAddress s)  -- | Variant of 'waitReply' that runs 'messageDatum'.-waitDatum :: RecvOSC m => Address_Pattern -> m [Datum]-waitDatum = liftM messageDatum . waitReply+waitDatum :: RecvOSC m => Packet.Address_Pattern -> m [Datum.Datum]+waitDatum = liftM Packet.messageDatum . waitReply

@@ -5,9 +5,9 @@  -- * Timeout --- | Real valued variant of 'timeout'.+-- | Variant of 'timeout' where time is given in fractional seconds. timeout_r :: Double -> IO a -> IO (Maybe a)-timeout_r t = timeout (floor (t * 1000000))+timeout_r = timeout . floor . (* 1000000)  -- * Wait @@ -21,6 +21,6 @@ -- | Repeat action until /f/ does not give 'Nothing' when applied to result. untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b untilMaybe f act =-    let g p = case f p of {Nothing -> recur;Just r -> return r}+    let g p = maybe recur return (f p)         recur = act >>= g     in recur

@@ -1,36 +1,35 @@ Name:              hosc-Version:           0.16+Version:           0.17 Synopsis:          Haskell Open Sound Control Description:       @hosc@ implements a subset of the Open Sound Control                    byte protocol, <http://opensoundcontrol.org/>.                    .                    See "Sound.OSC.Core" or "Sound.OSC" or "Sound.OSC.FD".-License:           GPL+License:           GPL-3 Category:          Sound-Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2017+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2018 Author:            Rohan Drape, Stefan Kersten-Maintainer:        rd@slavepianos.org+Maintainer:        rd@rohandrape.net Stability:         Experimental-Homepage:          http://rd.slavepianos.org/t/hosc-Tested-With:       GHC == 8.0.1+Homepage:          http://rohandrape.net/t/hosc+Tested-With:       GHC == 8.4.3 Build-Type:        Simple Cabal-Version:     >= 1.8 Data-Files:        README  Library-  Build-Depends:   base >= 4.7 && < 5,+  Build-Depends:   base >= 4.8 && < 5,                    binary >= 0.7.2,                    blaze-builder >= 0.3,                    bytestring,                    data-binary-ieee754,                    network >= 2.3,-                   time,+                   time >= 1.5,                    transformers   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.OSC                    Sound.OSC.Coding.Byte                    Sound.OSC.Coding.Cast-                   Sound.OSC.Coding.Class                    Sound.OSC.Coding.Convert                    Sound.OSC.Coding.Decode.Base                    Sound.OSC.Coding.Decode.Binary@@ -38,13 +37,8 @@                    Sound.OSC.Coding.Encode.Builder                    Sound.OSC.Core                    Sound.OSC.Datum-                   Sound.OSC.Datum.Datem-                   Sound.OSC.Datum.Normalise-                   Sound.OSC.Datum.Unpack                    Sound.OSC.FD                    Sound.OSC.Packet-                   Sound.OSC.Packet.Class-                   Sound.OSC.Packet.Coerce                    Sound.OSC.Time                    Sound.OSC.Transport.FD                    Sound.OSC.Transport.FD.TCP@@ -53,5 +47,5 @@                    Sound.OSC.Wait  Source-Repository  head-  Type:            darcs-  Location:        http://rd.slavepianos.org/sw/hosc/+  Type:            git+  Location:        https://github.com/rd--/hosc.git