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

[Jamey Sharp]

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

Modified Files:
	XCBExt.hs 
Log Message:
Add tracing so we can see what order lazy evaluation plus monad sequencing is selecting.

Index: XCBExt.hs
===================================================================
RCS file: /cvs/xcb/xhsb/XCBExt.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- XCBExt.hs	10 Jan 2006 23:10:30 -0000	1.3
+++ XCBExt.hs	10 Jan 2006 23:17:22 -0000	1.4
@@ -9,6 +9,9 @@
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Generics
+import Debug.Trace
+
+trace' s = trace $ " * " ++ s
 
 type ReplyReader a = StateT Int (ReaderT (ForeignPtr Word32) IO) a
 
@@ -17,8 +20,8 @@
     last <- get
     let cur = (last + size - 1) .&. (-size)
     put $ cur + size
-    p <- ask
-    liftIO $ liftIO $ unsafeInterleaveIO $ withForeignPtr p $ \p'-> peek $ plusPtr p' cur
+    p <- return . trace' "read pointer" =<< ask
+    liftIO $ liftIO $ unsafeInterleaveIO $ withForeignPtr p $ \p'-> trace' "peek" $ peek $ plusPtr p' cur
 
 retTypeM :: Monad m => m a -> a
 retTypeM _ = undefined
@@ -46,9 +49,9 @@
 
 foreign import ccall "X11/XCB/xcbext.h XCBWaitForReply" _waitForReply :: Ptr XCBConnection -> Word32 -> Ptr (Ptr XCBGenericError) -> IO (Ptr Word32)
 
-request = throwIf (== 0) (const "couldn't send request")
+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
     cookie <- request req
-    unsafeInterleaveIO $ 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 readReply