Binary read/write WAS [storing to a file]

[Shawn P. Garbett]

I've been fiddling with binary read/write in Haskell. I put together a li=
ttle=20
example demonstrating my lack of understanding. It creates a connection=20
requestion XAtom and spits it out over a socket. My real hangup occurs wh=
en I=20
get a String back from the Socket and would like it nicely marshalled int=
o=20
the ConnectSuccess type. These techniques I would assume apply to binary=20
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 =3D  many1 (satisfy $ \c -> c /=3D ':')

-- Parse out the display name from the environment Variable DISPLAY
parseDisplay   :: String -> String
parseDisplay s =3D  if (name =3D=3D "")
                    then "localhost"
                    else name
                  where name =3D case (parse beforeColon "" s) of
                                 Left err -> ""
                                 Right x  -> x
               =20
-- repeat an IO action multiple times
repeat'     :: Int -> IO a -> IO ()
repeat' n f =3D  foldr (>>) (return ()) (take n (repeat f))

-- Send the X11 Connection Request to a handle
sendConnectReq   :: Handle -> IO ()
sendConnectReq h =3D  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,=20
open.hs:xx=20
                      hPutChar h '\x6c' --platform dependent byte-orderin=
g,=20
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 bou=
ndary
                      hFlush h

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

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

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

-- Connection success type to fill up with wonderful stuff
data ConnectSuccess =3D 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 }=20

-- Main program to make an X11 connection request.
main :: IO ()
main =3D  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'