Rip "Scrap Your Boilerplate" stuff out again so more information than just

    order and type of fields can be recorded and used.

2 files changed, 11 insertions, 19 deletions

diff --git a/xhsb/XCBExt.hs b/xhsb/XCBExt.hs
index 39624e2..81315cc 100644
--- a/xhsb/XCBExt.hs
+++ b/xhsb/XCBExt.hs
@@ -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 @@ readBool = do
     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)
diff --git a/xhsb/XProto.hs b/xhsb/XProto.hs
index 5227246..43d25eb 100644
--- a/xhsb/XProto.hs
+++ b/xhsb/XProto.hs
@@ -16,4 +16,10 @@ data InternAtomReply = InternAtomReply { internAtomResponseType :: Word8, intern
 
 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