it works

Multi-user client-server debug-me is working, almost perfectly.

All that was missing was replaying the log when the developer connected.
A number of race conditions had to be avoided to do that sanely.

This commit was sponsored by Ignacio on Patreon.

1 files changed, 12 insertions, 3 deletions

diff --git a/SessionID.hs b/SessionID.hs
index d643a28..8bf8f7d 100644
--- a/SessionID.hs
+++ b/SessionID.hs
@@ -20,6 +20,8 @@ import Data.Maybe
 import Data.List
 import Data.UUID
 import Data.UUID.V4
+import Control.Concurrent.STM
+import Control.Exception
 
 -- | A SessionID is the base name of the log file to use,
 -- and may not contain any path information.
@@ -51,11 +53,11 @@ mkSessionID s
 sessionLogFile :: FilePath -> SessionID -> FilePath
 sessionLogFile dir (SessionID f) = dir </> "debug-me." ++ f ++ ".log"
 
--- | Allocate a new SessionID and return an open Handle to its log file.
+-- | Allocate a new SessionID open a Handle to its log file.
 --
 -- A UUID is used, to avoid ever generating a SessionID that has been used
 -- before.
-withSessionID :: FilePath -> ((Handle, SessionID) -> IO a) -> IO a
+withSessionID :: FilePath -> ((TVar Handle, SessionID) -> IO a) -> IO a
 withSessionID dir a = do
 	createDirectoryIfMissing False dir
 	sid <- SessionID . toString <$> nextRandom
@@ -66,7 +68,14 @@ withSessionID dir a = do
 	exists <- doesFileExist f
 	if exists
 		then withSessionID dir a
-		else withFile f WriteMode $ \h -> a (h, sid)
+		else bracket (setup f) cleanup (go sid)
+  where
+	setup f = do
+		h <- openFile f WriteMode
+		hv <- newTVarIO h
+		return hv
+	cleanup hv = hClose =<< atomically (readTVar hv)
+	go sid hv = a (hv, sid)
 
 type UrlString = String