diff options
Diffstat (limited to 'SessionID.hs')
| -rw-r--r-- | SessionID.hs | 15 |
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 |