DPut Trace Variations

        tput - like dput, but works in any Applicative
        dtrace - like trace, but takes DebugTag

1 files changed, 22 insertions, 16 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index e0221f5a..8182706e 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -35,7 +35,7 @@ import Control.Applicative
 import Data.Word
 import Data.Array.MArray
 import Data.Maybe
-import Debug.Trace
+import DPut
 
 data PacketQueue a = PacketQueue
     { pktq    :: TArray Word32 (Maybe a)
@@ -234,15 +234,18 @@ peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoT
     let arrayEmpty :: MArray a e m => a Word32 e -> m Bool
         arrayEmpty ar = do (lowB,highB) <- getBounds ar
                            let result= lowB > highB
-                           return $ trace ("arrayEmpty result=" ++ show result
+                           tput XNetCrypto
+                                        ("arrayEmpty result=" ++ show result
                                         ++ " lowB="    ++ show lowB
                                         ++ " highB = " ++ show highB
-                                        ++ " i = " ++ show i) result
+                                        ++ " i = " ++ show i)
+                           return result
     mbPkt <- do emp <- arrayEmpty (pktq pktoOutPQ)
-                if emp then trace "(peekPacket empty)"    $ return Nothing
-                       else trace "(peekPacket nonempty)" $ do
+                if emp then tput XNetCrypto "(peekPacket empty)" >> return Nothing
+                       else do  tput XNetCrypto "(peekPacket nonempty)"
                                 result <- readArray (pktq pktoOutPQ) i
-                                return $ trace ("readArray (isJust result)=="  ++ show (isJust result)) result
+                                tput XNetCrypto ("readArray (isJust result)=="  ++ show (isJust result))
+                                return result
     pktno <- readTVar pktoPacketNo
     nextno <- readTVar (seqno pktoInPQ)
     pktoToWire getExtra nextno be pktno msg
@@ -252,37 +255,40 @@ peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoT
 --   index in this implementation.)
 tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM OutGoingResult
 tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg
-  = trace "(tryAppendQueueOutgoing)" $ do
+  = dtrace XNetCrypto "(tryAppendQueueOutgoing)" $ do
     be <- readTVar (buffend pktoOutPQ)
     let i = be `mod` (qsize pktoOutPQ)
     let arrayEmpty :: MArray a e m => a Word32 e -> m Bool
         arrayEmpty ar = do (lowB,highB) <- getBounds ar
                            let result= lowB > highB
-                           return $ trace ("arrayEmpty result=" ++ show result
+                           tput XNetCrypto
+                                        ("arrayEmpty result=" ++ show result
                                         ++ " lowB="    ++ show lowB
                                         ++ " highB = " ++ show highB
-                                        ++ " i = " ++ show i) result
+                                        ++ " i = " ++ show i)
+                           return result
     mbPkt <- do emp <- arrayEmpty (pktq pktoOutPQ)
-                if emp then trace "(tryAppendQueueOutgoing empty)"    $ return Nothing
-                       else trace "(tryAppendQueueOutgoing nonempty)" $ do
+                if emp then tput XNetCrypto "(tryAppendQueueOutgoing empty)" >> return Nothing
+                       else do  tput XNetCrypto "(tryAppendQueueOutgoing nonempty)"
                                 result <- readArray (pktq pktoOutPQ) i
-                                return $ trace ("readArray (isJust result)=="  ++ show (isJust result)) result
+                                tput XNetCrypto ("readArray (isJust result)=="  ++ show (isJust result))
+                                return result
     pktno <- readTVar pktoPacketNo
     nextno <- readTVar (seqno pktoInPQ)
     mbWire <- pktoToWire getExtra nextno be pktno msg
     -- TODO all the above lines ^^ can be replaced with call to peekPacket
-    case trace "(tryAppendQueueOutgoing mbWire)" mbWire of
+    case dtrace XNetCrypto "(tryAppendQueueOutgoing mbWire)" mbWire of
         Just (pkt,pktno')
-            -> trace "(tryAppendQueueOutgoing A)"
+            -> dtrace XNetCrypto "(tryAppendQueueOutgoing A)"
              $ case mbPkt of
                     -- slot is free, insert element
-                    Nothing -> trace "(tryAppendQueueOutgoing Nothing case)" $ do
+                    Nothing -> dtrace XNetCrypto "(tryAppendQueueOutgoing Nothing case)" $ do
                         modifyTVar' (buffend pktoOutPQ) (+1)
                         writeTVar pktoPacketNo $! pktno'
                         writeArray (pktq pktoOutPQ) i (Just (pktno,pkt))
                         return OGSuccess
                     -- queue is full
-                    Just (n,_) -> trace "tryAppendQueueOutgoing Just case)" $ do
+                    Just (n,_) -> dtrace XNetCrypto "tryAppendQueueOutgoing Just case)" $ do
                         nn <- getHighestHandledPacketPlus1 q
                         if (n < nn)
                           -- but we can overwrite an old packet