Binary read/write WAS [storing to a file]

14 Nov 2002

      I've been fiddling with binary read/write in Haskell. I put together a little 
example demonstrating my lack of understanding. It creates a connection 
requestion XAtom and spits it out over a socket. My real hangup occurs when I 
get a String back from the Socket and would like it nicely marshalled into 
the ConnectSuccess type. These techniques I would assume apply to binary 
read/write for files as well.

Any criticism/suggestions are appreciated.

import IO
import Monad
import GHC.IO
import GHC.Storable
import Network
import Network.Socket
import Data.Char
import Data.Word
import System.Environment
import Parsec

-- A Parser that looks for everything before the colon
beforeColon :: Parser String
beforeColon =  many1 (satisfy $ \c -> c /= ':')

-- Parse out the display name from the environment Variable DISPLAY
parseDisplay   :: String -> String
parseDisplay s =  if (name == "")
                    then "localhost"
                    else name
                  where name = case (parse beforeColon "" s) of
                                 Left err -> ""
                                 Right x  -> x

-- repeat an IO action multiple times
repeat'     :: Int -> IO a -> IO ()
repeat' n f =  foldr (>>) (return ()) (take n (repeat f))

-- Send the X11 Connection Request to a handle
sendConnectReq   :: Handle -> IO ()
sendConnectReq h =  do
                      -- O'Reilly claims this should be '\x66'
                      -- Try it with this and it crashes like so
                      -- *** Exception: user error
                      -- Reason: Pattern match failure in do expression, 
open.hs:xx 
                      hPutChar h '\x6c' --platform dependent byte-ordering, 
MSB

                      hPutChar h '\x00' --unused
                      hPutChar h '\x0b' --protocol major 11
                      hPutChar h '\x00' --protocol minor 0
                      repeat' 8 (hPutChar h '\x00')  -- pad it out to boundary
                      hFlush h

-- Totally clueless on this one
-- What's the best for this?
marshallSuccess   :: String -> ConnectSuccess
marshallSuccess s = let v = drop 39 s in
                    ConnectSuccess 0 0 0 0 0 0 0 0 0 0 0 0 v

-- Get the reply 
getConnectReply   :: Handle -> IO (Either ConnectFail ConnectSuccess)
getConnectReply h =  do
                       (r:rs) <- hGetContents h -- This is the line that 
crashes with an invalid request (reply ""?)
                       if (r == '\x00')
                         then return (Left (drop 7 rs))
                         else return (Right (marshallSuccess rs))

-- Error string, this probably should be an ioexception type
type ConnectFail = String

-- Connection success type to fill up with wonderful stuff
data ConnectSuccess = ConnectSuccess { release     :: Word32,
                                       id_base     :: Word32,
                                       id_mask     :: Word32,
                                       motion_buf  :: Word32,
                                       max_req     :: Word16,
                                       screens     :: Word8,
                                       img_order   :: Word8,
                                       bit_order   :: Word8,
                                       bit_unit    :: Word8,
                                       bit_pad     :: Word8,
                                       min_keycode :: Word8,
                                       max_keycode :: Word8,
                                       vendor      :: String } 

-- Main program to make an X11 connection request.
main :: IO ()
main =  withSocketsDo $ do
          hostname <- liftM parseDisplay (getEnv "DISPLAY")
          h <- connectTo hostname (Service "x11")
          sendConnectReq h
          reply <- getConnectReply h
          case reply of
            Left s  -> putStr "Failure: " >> putStr s >> putChar '\n'
            Right s -> putStr "Success: " >> putStr (vendor s) >> putChar '\n'

Binary read/write WAS [storing to a file]

Shawn P. Garbett