Properly closing a `LoggerSet` file descriptor?

[parsonsmatt]

I'm debugging a problem with our DevelMain style approach to running a Yesod webserver in GHCi. When we're loaded in ghciwatch, we want to send logs to a file due to the way that ghciwatch handles stdout.

The code we use for that is here:

makeDebugLogger path = do
  loggerSet <- newFileLoggerSetN defaultBufSize (Just 1) path
  pure (Yes.Logger loggerSet appDateCacheGetter)

The DevelMain uses foreign-store, following this pattern. The primary difference is that we use a continuation passing style for our App, so it looks more like this:

start done = do
  forkIO do
    getApplicationRepl \site port app -> do
      finally 
        (runSettings (setPort port defaultSettings) app)
        performMajorGC

getApplicationRepl calls ``action site port app finally cleanupAppResources site`

cleanupAppResources :: App -> IO ()
cleanupAppResources App {..} = do
  -- some other cleanup . . .
  flushLogStr $ Yes.loggerSet appLogger
  rmLoggerSet $ Yes.loggerSet appLogger

When I call DevelMain.update for the first time, everything works. When I call it a second time, it sees the existing ThreadId and sends a killThread to it. This should cause all the bracket and finally to roll back and clean things up, including rmLoggerSet on the app's logger. This should unlock the file. Unfortunately, that does not happen - when we call into getApplicationRepl to start another webapp with the loaded logs, it fails with an error: resource busy (file is locked).

If I mimic this in ghci without threading, it works fine.

ghci> logger <- newFileLoggerSetN defaultBufSize (Just 1) "logs.txt"
ghci> logger' <- newFileLoggerSetN defaultBufSize (Just 1) "logs.txt"
error: resource busy (file is locked)
ghci> rmLoggerSet logger
ghci> logger' <- newFileLoggerSetN defaultBufSize (Just 1) "logs.txt"
ghci> -- no errors

So something fishy is going on here.

I'll comment further with a reproduction or a diagnosis when I have one.

[kazu-yamamoto]

I cannot follow in detail. But if rmLoggerSet is called, fd should be closed since rmLoggerSet is defined as follows:

rmLoggerSet :: LoggerSet -> IO ()
rmLoggerSet LoggerSet{..} = do
    fd <- readIORef lgrsetFdRef
    when (isFDValid fd) $ do
        case lgrsetLogger of
          SL sl -> stopLoggers sl
          ML ml -> stopLoggers ml
        when (isJust lgrsetFilePath) $ closeFD fd
        writeIORef lgrsetFdRef invalidFD

You can check if rmLoggerSet is called by putting putStrLn in cleanupAppResources.