[Xcb-commit] xhsb XCBExt.hs,1.6,1.7 XProto.hs,1.3,1.4

[Jamey Sharp]

Update of /cvs/xcb/xhsb
In directory gabe:/tmp/cvs-serv25522

Modified Files:
	XCBExt.hs XProto.hs 
Log Message:
Rip "Scrap Your Boilerplate" stuff out again so more information than just order and type of fields can be recorded and used.

Index: XProto.hs
===================================================================
RCS file: /cvs/xcb/xhsb/XProto.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- XProto.hs	10 Jan 2006 23:33:02 -0000	1.3
+++ XProto.hs	10 Jan 2006 23:44:43 -0000	1.4
@@ -16,4 +16,10 @@
 
 internAtom :: Ptr XCBConnection -> Bool -> String -> IO InternAtomReply
 internAtom c onlyIfExists name =
-    requestWithReply c $ withCStringLen name (\(name, name_len)-> _internAtom c (fromBool onlyIfExists) (toEnum name_len) name)
+        requestWithReply c reader $ withCStringLen name (\(name, name_len)-> _internAtom c (fromBool onlyIfExists) (toEnum name_len) name)
+    where reader = do
+            responseType <- readStorable
+            sequence <- readStorable
+            length <- readStorable
+            atom <- readStorable
+            return $ InternAtomReply responseType sequence length atom

Index: XCBExt.hs
===================================================================
RCS file: /cvs/xcb/xhsb/XCBExt.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- XCBExt.hs	10 Jan 2006 23:28:53 -0000	1.6
+++ XCBExt.hs	10 Jan 2006 23:44:43 -0000	1.7
@@ -1,14 +1,12 @@
 {-# OPTIONS -ffi #-}
-module XCBExt(request, requestWithReply) where
+module XCBExt(ReplyReader, readSize, readStorable, readBool, request, requestWithReply) where
 
 import XCB
 import Control.Exception
 import System.IO.Unsafe(unsafeInterleaveIO)
 import Foreign
-
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.Generics
 import Debug.Trace
 
 trace' s = trace $ " * " ++ s
@@ -35,24 +33,12 @@
     v <- readSize 1
     return $ (v :: Word8) /= 0
 
-readReply :: Data reply => ReaderT (ForeignPtr Word32) IO reply
-readReply = ret
-    where
-        ret = evalStateT (fromConstrM reader c) 0
-        reader :: Typeable a => ReplyReader a
-        reader = fail "no reader for this type"
-            `extR` (readBool)
-            `extR` (readStorable :: ReplyReader Word8)
-            `extR` (readStorable :: ReplyReader Word16)
-            `extR` (readStorable :: ReplyReader Word32)
-        c = indexConstr (dataTypeOf $ retTypeM ret) 1
-
 foreign import ccall "X11/XCB/xcbext.h XCBWaitForReply" _waitForReply :: Ptr XCBConnection -> Word32 -> Ptr (Ptr XCBGenericError) -> IO (Ptr Word32)
 
 request :: IO Word32 -> IO Word32
 request = return . trace' "sent request" =<< throwIf (== 0) (const "couldn't send request")
 
-requestWithReply :: Data reply => Ptr XCBConnection -> IO Word32 -> IO reply
-requestWithReply c req = do
+requestWithReply :: Ptr XCBConnection -> ReplyReader reply -> IO Word32 -> IO reply
+requestWithReply c readReply req = do
     cookie <- request req
-    unsafeInterleaveIO $ trace' "got reply" $ throwIfNull "couldn't get reply" (_waitForReply c cookie nullPtr) >>= newForeignPtr finalizerFree >>= runReaderT readReply
+    unsafeInterleaveIO $ trace' "got reply" $ throwIfNull "couldn't get reply" (_waitForReply c cookie nullPtr) >>= newForeignPtr finalizerFree >>= runReaderT (evalStateT readReply 0)