[Xcb-commit] xhsb XCBExt.hs,1.2,1.3

[Jamey Sharp]

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

Modified Files:
	XCBExt.hs 
Log Message:
Use a Reader monad instead of passing the ForeignPtr down through all the calls.

Index: XCBExt.hs
===================================================================
RCS file: /cvs/xcb/xhsb/XCBExt.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- XCBExt.hs	10 Jan 2006 11:55:42 -0000	1.2
+++ XCBExt.hs	10 Jan 2006 23:10:30 -0000	1.3
@@ -6,38 +6,42 @@
 import System.IO.Unsafe(unsafeInterleaveIO)
 import Foreign
 
+import Control.Monad.Reader
 import Control.Monad.State
 import Data.Generics
 
-readSize :: Storable a => Int -> ForeignPtr p -> StateT Int IO a
-readSize size p = do
+type ReplyReader a = StateT Int (ReaderT (ForeignPtr Word32) IO) a
+
+readSize :: Storable a => Int -> ReplyReader a
+readSize size = do
     last <- get
     let cur = (last + size - 1) .&. (-size)
     put $ cur + size
-    liftIO $ unsafeInterleaveIO $ withForeignPtr p $ \p'-> peek $ plusPtr p' cur
+    p <- ask
+    liftIO $ liftIO $ unsafeInterleaveIO $ withForeignPtr p $ \p'-> peek $ plusPtr p' cur
 
 retTypeM :: Monad m => m a -> a
 retTypeM _ = undefined
 
-readGenericM :: Storable a => ForeignPtr p -> StateT Int IO a
-readGenericM p = action
-    where action = readSize (sizeOf $ retTypeM action) p
+readGenericM :: Storable a => ReplyReader a
+readGenericM = action
+    where action = readSize (sizeOf $ retTypeM action)
 
-readBoolM :: ForeignPtr p -> StateT Int IO Bool
-readBoolM p = do
-    v <- readSize 1 p
+readBoolM :: ReplyReader Bool
+readBoolM = do
+    v <- readSize 1
     return $ (v :: Word8) /= 0
 
-readReply :: Data reply => ForeignPtr p -> IO reply
-readReply p = ret
+readReply :: Data reply => ReaderT (ForeignPtr Word32) IO reply
+readReply = ret
     where
         ret = evalStateT (fromConstrM reader c) 0
-        reader :: Typeable a => StateT Int IO a
+        reader :: Typeable a => ReplyReader a
         reader = fail "no reader for this type"
-            `extR` (readBoolM p)
-            `extR` (readGenericM p :: StateT Int IO Word8)
-            `extR` (readGenericM p :: StateT Int IO Word16)
-            `extR` (readGenericM p :: StateT Int IO Word32)
+            `extR` (readBoolM)
+            `extR` (readGenericM :: ReplyReader Word8)
+            `extR` (readGenericM :: ReplyReader Word16)
+            `extR` (readGenericM :: 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)
@@ -47,4 +51,4 @@
 requestWithReply :: Data reply => Ptr XCBConnection -> IO Word32 -> IO reply
 requestWithReply c req = do
     cookie <- request req
-    unsafeInterleaveIO $ throwIfNull "couldn't get reply" (_waitForReply c cookie nullPtr) >>= newForeignPtr finalizerFree >>= readReply
+    unsafeInterleaveIO $ throwIfNull "couldn't get reply" (_waitForReply c cookie nullPtr) >>= newForeignPtr finalizerFree >>= runReaderT readReply