diff --git a/opensoundcontrol-ht.cabal b/opensoundcontrol-ht.cabal --- a/opensoundcontrol-ht.cabal +++ b/opensoundcontrol-ht.cabal @@ -1,8 +1,7 @@ Name: opensoundcontrol-ht -Version: 0.2 +Version: 0.3 License: GPL License-File: LICENSE -Copyright: Henning Thielemann, 2009-2013 Author: Henning Thielemann Maintainer: Henning Thielemann Stability: Experimental @@ -19,7 +18,7 @@ . Also see the supercollider-ht package which uses this one. Category: Sound -Tested-With: GHC==7.4.2 +Tested-With: GHC==7.4.2, GHC==7.8.3 Cabal-Version: >=1.6 Build-Type: Simple Source-Repository head @@ -29,7 +28,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/opensoundcontrol/ - tag: 0.2 + tag: 0.3 Flag splitBase @@ -37,15 +36,15 @@ Library Build-Depends: - hosc >=0.13 && <0.14, + hosc >=0.15 && <0.16, transformers >=0.2 && <0.5, - binary >=0.2 && <0.6, + binary >=0.7 && <0.8, bytestring >=0.9 && <0.11, utility-ht >=0.0.1 && <0.1 If flag(splitBase) Build-Depends: random >=1.0 && <2, - process >=1.0 && <1.2, + process >=1.0 && <1.3, base >=2 && <5 Else Build-Depends: base >=1.0 && <2 @@ -53,5 +52,5 @@ GHC-Options: -Wall Hs-source-dirs: src Exposed-modules: - Sound.OpenSoundControl.Transport.File - Sound.OpenSoundControl.Transport.Monad.ByteString + Sound.OSC.Transport.File + Sound.OSC.Transport.Monad.ByteString diff --git a/src/Sound/OSC/Transport/File.hs b/src/Sound/OSC/Transport/File.hs new file mode 100644 --- /dev/null +++ b/src/Sound/OSC/Transport/File.hs @@ -0,0 +1,36 @@ +module Sound.OSC.Transport.File (T, open, ) where + +import qualified Sound.OSC.Type as OSC +import Sound.OSC.Coding.Byte (encode_u32, ) +import Sound.OSC.Class (encodeOSC, ) +import Sound.OSC.Transport.FD (Transport(..), ) + +import qualified Data.ByteString.Lazy as B +import System.IO (Handle, openBinaryFile, hClose, IOMode(WriteMode), ) +import Control.Monad (liftM, ) + + +-- | The File transport handle data type. +data T = Cons OSC.Packet Handle + deriving (Eq, Show) + + +instance Transport T where + sendOSC (Cons _ h) msg = + let b = encodeOSC msg + n = fromIntegral (B.length b) + in B.hPut h (B.append (encode_u32 n) b) + + recvPacket (Cons msg _) = return msg + + close (Cons _ h) = hClose h + + + +{- | +Open a command file. +All 'recv' calls are answered with @msg@. +-} +open :: OSC.Packet -> FilePath -> IO T +open msg fileName = + liftM (Cons msg) $ openBinaryFile fileName WriteMode diff --git a/src/Sound/OSC/Transport/Monad/ByteString.hs b/src/Sound/OSC/Transport/Monad/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Sound/OSC/Transport/Monad/ByteString.hs @@ -0,0 +1,50 @@ +module Sound.OSC.Transport.Monad.ByteString (T, run, ) where + +import qualified Sound.OSC.Transport.Monad as TM + +import qualified Sound.OSC.Type as OSC +import Sound.OSC.Class (encodeOSC, ) + +import qualified Data.ByteString.Lazy as B +import qualified Data.Binary.Put as Put + +import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask, ) +import Control.Monad.Trans.Class (lift, ) +import Control.Monad (ap, ) +import Control.Applicative (Applicative, pure, (<*>), ) + + +newtype T a = Cons {decons :: ReaderT OSC.Packet Put.PutM a} + + +instance Functor T where + fmap f (Cons act) = Cons $ fmap f act + +instance Applicative T where + pure = return + (<*>) = ap + +instance Monad T where + return = Cons . return + Cons x >>= k = + Cons $ decons . k =<< x + + +instance TM.SendOSC T where + sendOSC msg = Cons $ lift $ + let b = encodeOSC msg + in Put.putWord32be (fromIntegral (B.length b)) >> + Put.putLazyByteString b + +instance TM.RecvOSC T where + recvPacket = Cons ask + +instance TM.DuplexOSC T where + + +{- | +Write sent messages to a ByteString. +All 'recv' calls are answered with @msg@. +-} +run :: OSC.Packet -> T () -> B.ByteString +run msg (Cons m) = Put.runPut (runReaderT m msg) diff --git a/src/Sound/OpenSoundControl/Transport/File.hs b/src/Sound/OpenSoundControl/Transport/File.hs deleted file mode 100644 --- a/src/Sound/OpenSoundControl/Transport/File.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Sound.OpenSoundControl.Transport.File (T, open, ) where - -import qualified Sound.OpenSoundControl.Type as OSC -import Sound.OpenSoundControl.Coding.Byte (encode_u32, ) -import Sound.OpenSoundControl.Class (encodeOSC, ) -import Sound.OSC.Transport.FD (Transport(..), ) - -import qualified Data.ByteString.Lazy as B -import System.IO (Handle, openBinaryFile, hClose, IOMode(WriteMode), ) -import Control.Monad (liftM, ) - - --- | The File transport handle data type. -data T = Cons OSC.Packet Handle - deriving (Eq, Show) - - -instance Transport T where - sendOSC (Cons _ h) msg = - let b = encodeOSC msg - n = fromIntegral (B.length b) - in B.hPut h (B.append (encode_u32 n) b) - - recvPacket (Cons msg _) = return msg - - close (Cons _ h) = hClose h - - - -{- | -Open a command file. -All 'recv' calls are answered with @msg@. --} -open :: OSC.Packet -> FilePath -> IO T -open msg fileName = - liftM (Cons msg) $ openBinaryFile fileName WriteMode diff --git a/src/Sound/OpenSoundControl/Transport/Monad/ByteString.hs b/src/Sound/OpenSoundControl/Transport/Monad/ByteString.hs deleted file mode 100644 --- a/src/Sound/OpenSoundControl/Transport/Monad/ByteString.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Sound.OpenSoundControl.Transport.Monad.ByteString (T, run, ) where - -import qualified Sound.OSC.Transport.Monad as TM - -import qualified Sound.OpenSoundControl.Type as OSC -import Sound.OpenSoundControl.Class (encodeOSC, ) - -import qualified Data.ByteString.Lazy as B -import qualified Data.Binary.Put as Put - -import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask, ) -import Control.Monad.Trans.Class (lift, ) - - -newtype T a = Cons {decons :: ReaderT OSC.Packet Put.PutM a} - - -instance Functor T where - fmap f (Cons act) = Cons $ fmap f act - -instance Monad T where - return = Cons . return - Cons x >>= k = - Cons $ decons . k =<< x - - -instance TM.SendOSC T where - sendOSC msg = Cons $ lift $ - let b = encodeOSC msg - in Put.putWord32be (fromIntegral (B.length b)) >> - Put.putLazyByteString b - -instance TM.RecvOSC T where - recvPacket = Cons ask - -instance TM.DuplexOSC T where - - -{- | -Write sent messages to a ByteString. -All 'recv' calls are answered with @msg@. --} -run :: OSC.Packet -> T () -> B.ByteString -run msg (Cons m) = Put.runPut (runReaderT m msg)