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