Fix snapshotting

We also need to find all the RequestBlock requests and add those into
the block cache, as well as the results of RequestAllBlocks.

client/src/GHC/Debug/Client/Monad/Simple.hs

@@ -123,9 +123,7 @@ instance DebugMonad DebugM where
 
 initBlockCacheFromReqCache :: RequestCache -> BlockCache
 initBlockCacheFromReqCache new_req_cache  =
-  case lookupReq RequestAllBlocks new_req_cache of
-        Just bs -> addBlocks bs emptyBlockCache
-        Nothing -> emptyBlockCache
+  addBlocks (lookupBlocks new_req_cache) emptyBlockCache
 
 
 

client/src/GHC/Debug/Client/RequestCache.hs

@@ -4,6 +4,7 @@
 module GHC.Debug.Client.RequestCache(RequestCache
                                     , cacheReq
                                     , lookupReq
+                                    , lookupBlocks
                                     , emptyRequestCache
                                     , clearMovableRequests
                                     , putCache
@@ -33,6 +34,21 @@ lookupReq req (RequestCache rc) = coerceResult <$> HM.lookup (AnyReq req) rc
     coerceResult :: AnyResp -> resp
     coerceResult (AnyResp a _) = unsafeCoerce a
 
+lookupBlocks :: RequestCache -> [RawBlock]
+lookupBlocks c@(RequestCache rc) =
+  let all_blocks = case lookupReq RequestAllBlocks c of
+                        Just bs -> bs
+                        Nothing -> []
+
+      get_block :: AnyReq -> AnyResp -> [RawBlock] -> [RawBlock]
+      get_block (AnyReq (RequestBlock {})) (AnyResp resp _) bs = unsafeCoerce resp : bs
+      get_block _ _ bs = bs
+
+      individual_blocks = HM.foldrWithKey get_block [] rc
+
+  in (all_blocks ++ individual_blocks)
+
+
 emptyRequestCache :: RequestCache
 emptyRequestCache = RequestCache HM.empty