Switched cache-update semantics to remove explicit IORef type

1 files changed, 14 insertions, 16 deletions

diff --git a/SendMessage.hs b/SendMessage.hs
index c6eec01e..ff779e11 100644
--- a/SendMessage.hs
+++ b/SendMessage.hs
@@ -61,28 +61,24 @@ type OutgoingToPeer sock cache msg =
          -> ByteStringSink
          -> IO (Maybe msg)
 
-class CacheableCommand cmd where
-    type CacheRef cmd :: *
-    type Cache cmd :: *
+-- |Strict version of 'modifyIORef'
+modifyIORef' :: IORef a -> (a -> a) -> IO ()
+modifyIORef' ref f = do
+    x <- readIORef ref
+    let x' = f x
+    x' `seq` writeIORef ref x'
 
-    emptyCache :: CacheRef cmd
-
-    cache :: cmd -> CacheRef cmd -> IO ()
-
-    interpretCommands :: SocketLike sock => 
-        sock -> Cache cmd -> TChan cmd -> ByteStringSink -> IO (Maybe cmd)
-    
 
 sendMessage  :: 
-    (cache, msg -> IORef cache -> IO (), OutBoundXML RestrictedSocket cache msg) -> TVar (Map Peer (TChan msg, ThreadId)) -> msg -> Peer -> IO ()
-sendMessage (newCache,cacheCmd,toPeer) cons msg peer0 = do
+    (cache, msg -> cache -> cache, OutBoundXML RestrictedSocket cache msg) -> TVar (Map Peer (TChan msg, ThreadId)) -> msg -> Peer -> IO ()
+sendMessage (newCache,updateCache,toPeer) cons msg peer0 = do
     let peer = discardPort peer0
     found <- atomically $ do
         consmap <- readTVar cons
         return (Map.lookup peer consmap)
     let newEntry = do
           chan <- atomically newTChan
-          t <- forkIO $ connect_to_server chan peer (newCache,cacheCmd,toPeer)
+          t <- forkIO $ connect_to_server chan peer (newCache,updateCache,toPeer)
           -- L.putStrLn $ "remote-map new: " <++> showPeer peer
           return (True,(chan,t))
     (is_new,entry) <- maybe newEntry
@@ -107,12 +103,14 @@ sendMessage (newCache,cacheCmd,toPeer) cons msg peer0 = do
         readTVar cons >>= writeTVar cons . Map.insert peer entry
 
 
-connect_to_server chan peer (newCache,cacheCmd,toPeer) = (>> return ()) . runMaybeT $ do
+connect_to_server chan peer (newCache,updateCache,toPeer) = (>> return ()) . runMaybeT $ do
     let port = 5269 :: Int
     -- We'll cache Presence notifications until the socket
     -- is ready.
     cached <- liftIO $ newIORef newCache
 
+    let cacheCmd msg cached = modifyIORef' cached (updateCache msg)
+
     fix $ \sendmsgs -> do
         connected <- liftIO . async $ connect' (peerAddr peer) port
 
@@ -175,8 +173,8 @@ mmInsert val key mm = Map.alter f key mm
 -}
 
 -- newCache = todo
-cacheCmd :: msg -> cache -> IO ()
-cacheCmd _ cached = todo
+-- cacheCmd :: msg -> cache -> IO ()
+-- cacheCmd _ cached = todo
 -- toPeer = todo
 
 type OutBoundXML sock cache msg =