From 7987157bfd99b8e2ec78f5030a49c2e16bf08321 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Apr 2017 13:00:04 -0400 Subject: 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. --- SessionID.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'SessionID.hs') 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 -- cgit v1.2.3