loggingThread :: Logger -> IO ()
loggingThread (Logger queue notifier filePath _ errAct) = initialize >>= go
  where
    --------------------------------------------------------------------------
    openIt | filePath == "-"      = return stdout
           | filePath == "stderr" = return stderr
           | otherwise =
               openFile filePath AppendMode `catch` \(e::SomeException) -> do
                   logInternalError $ "Can't open log file \"" ++
                                      filePath ++ "\".\n"
                   logInternalError $ "Exception: " ++ show e ++ "\n"
                   logInternalError $ "Logging to stderr instead. " ++
                                      "**THIS IS BAD, YOU OUGHT TO " ++
                                      "FIX THIS**\n\n"
                   return stderr

    --------------------------------------------------------------------------
    closeIt h = unless (h == stdout || h == stderr) $ hClose h

    --------------------------------------------------------------------------
    logInternalError = errAct . T.encodeUtf8 . T.pack

    --------------------------------------------------------------------------
    go (href, lastOpened) =
        loop (href, lastOpened) `catches`
          [ Handler $ \(_::AsyncException) -> killit (href, lastOpened)
          , Handler $ \(e::SomeException)  -> do
                logInternalError $ "logger got exception: "
                                   ++ Prelude.show e ++ "\n"
                threadDelay 20000000
                go (href, lastOpened) ]

    --------------------------------------------------------------------------
    initialize = do
        lh   <- openIt
        href <- newIORef lh
        t    <- getCurrentDateTime
        tref <- newIORef t
        return (href, tref)


    --------------------------------------------------------------------------
    killit (href, lastOpened) = do
        flushIt (href, lastOpened)
        h <- readIORef href
        closeIt h

    --------------------------------------------------------------------------
    flushIt (!href, !lastOpened) = do
        dl <- atomicModifyIORef queue $ \x -> (mempty,x)

        let !msgs = toLazyByteString dl
        h <- readIORef href
        (do L.hPut h msgs
            hFlush h) `catch` \(e::SomeException) -> do
                logInternalError $ "got exception writing to log " ++
                                   filePath ++ ": " ++ show e ++ "\n"
                logInternalError "writing log entries to stderr.\n"
                mapM_ errAct $ L.toChunks msgs

        -- close the file every 15 minutes (for log rotation)
        t   <- getCurrentDateTime
        old <- readIORef lastOpened

        when (t - old > 900) $ do
            closeIt h
            openIt >>= writeIORef href
            writeIORef lastOpened t

    --------------------------------------------------------------------------
    loop !d = do
        -- wait on the notification mvar
        _ <- takeMVar notifier

        -- grab the queued messages and write them out
        flushIt d

        -- at least five seconds between log dumps
        threadDelay 5000000
        loop d


------------------------------------------------------------------------------
-- | Kills a logger thread, causing any unwritten contents to be
-- flushed out to disk
loggingThread :: Logger -> IO ()
loggingThread (Logger queue notifier filePath _ errAct) = initialize >>= go
  where
    --------------------------------------------------------------------------
    openIt | filePath == "-"      = return stdout
           | filePath == "stderr" = return stderr
           | otherwise =
               openFile filePath AppendMode `catch` \(e::SomeException) -> do
                   logInternalError $ "Can't open log file \"" ++
                                      filePath ++ "\".\n"
                   logInternalError $ "Exception: " ++ show e ++ "\n"
                   logInternalError $ "Logging to stderr instead. " ++
                                      "**THIS IS BAD, YOU OUGHT TO " ++
                                      "FIX THIS**\n\n"
                   return stderr

    --------------------------------------------------------------------------
    closeIt h = unless (h == stdout || h == stderr) $ hClose h

    --------------------------------------------------------------------------
    logInternalError = errAct . T.encodeUtf8 . T.pack

    --------------------------------------------------------------------------
    go (href, lastOpened) =
        loop (href, lastOpened) `catches`
          [ Handler $ \(_::AsyncException) -> killit (href, lastOpened)
          , Handler $ \(e::SomeException)  -> do
                logInternalError $ "logger got exception: "
                                   ++ Prelude.show e ++ "\n"
                threadDelay 20000000
                go (href, lastOpened) ]

    --------------------------------------------------------------------------
    initialize = do
        lh   <- openIt
        href <- newIORef lh
        t    <- getCurrentDateTime
        tref <- newIORef t
        return (href, tref)


    --------------------------------------------------------------------------
    killit (href, lastOpened) = do
        flushIt (href, lastOpened)
        h <- readIORef href
        closeIt h

    --------------------------------------------------------------------------
    flushIt (!href, !lastOpened) = do
        dl <- atomicModifyIORef queue $ \x -> (mempty,x)

        let !msgs = toLazyByteString dl
        h <- readIORef href
        (do L.hPut h msgs
            hFlush h) `catch` \(e::SomeException) -> do
                logInternalError $ "got exception writing to log " ++
                                   filePath ++ ": " ++ show e ++ "\n"
                logInternalError "writing log entries to stderr.\n"
                mapM_ errAct $ L.toChunks msgs

        -- close the file every 15 minutes (for log rotation)
        t   <- getCurrentDateTime
        old <- readIORef lastOpened

        when (t - old > 900) $ do
            closeIt h
            openIt >>= writeIORef href
            writeIORef lastOpened t

    --------------------------------------------------------------------------
    loop !d = do
        -- wait on the notification mvar
        _ <- takeMVar notifier

        -- grab the queued messages and write them out
        flushIt d

        -- at least five seconds between log dumps
        threadDelay 5000000
        loop d


------------------------------------------------------------------------------
-- | Kills a logger thread, causing any unwritten contents to be
-- flushed out to disk
loggingThread (Logger queue notifier filePath _ errAct) = initialize >>= go
  where
    --------------------------------------------------------------------------
    openIt | filePath == "-"      = return stdout
           | filePath == "stderr" = return stderr
           | otherwise =
               openFile filePath AppendMode `catch` \(e::SomeException) -> do
                   logInternalError $ "Can't open log file \"" ++
                                      filePath ++ "\".\n"
                   logInternalError $ "Exception: " ++ show e ++ "\n"
                   logInternalError $ "Logging to stderr instead. " ++
                                      "**THIS IS BAD, YOU OUGHT TO " ++
                                      "FIX THIS**\n\n"
                   return stderr

    --------------------------------------------------------------------------
    closeIt h = unless (h == stdout || h == stderr) $ hClose h

    --------------------------------------------------------------------------
    logInternalError = errAct . T.encodeUtf8 . T.pack

    --------------------------------------------------------------------------
    go (href, lastOpened) =
        loop (href, lastOpened) `catches`
          [ Handler $ \(_::AsyncException) -> killit (href, lastOpened)
          , Handler $ \(e::SomeException)  -> do
                logInternalError $ "logger got exception: "
                                   ++ Prelude.show e ++ "\n"
                threadDelay 20000000
                go (href, lastOpened) ]

    --------------------------------------------------------------------------
    initialize = do
        lh   <- openIt
        href <- newIORef lh
        t    <- getCurrentDateTime
        tref <- newIORef t
        return (href, tref)


    --------------------------------------------------------------------------
    killit (href, lastOpened) = do
        flushIt (href, lastOpened)
        h <- readIORef href
        closeIt h

    --------------------------------------------------------------------------
    flushIt (!href, !lastOpened) = do
        dl <- atomicModifyIORef queue $ \x -> (mempty,x)

        let !msgs = toLazyByteString dl
        h <- readIORef href
        (do L.hPut h msgs
            hFlush h) `catch` \(e::SomeException) -> do
                logInternalError $ "got exception writing to log " ++
                                   filePath ++ ": " ++ show e ++ "\n"
                logInternalError "writing log entries to stderr.\n"
                mapM_ errAct $ L.toChunks msgs

        -- close the file every 15 minutes (for log rotation)
        t   <- getCurrentDateTime
        old <- readIORef lastOpened

        when (t - old > 900) $ do
            closeIt h
            openIt >>= writeIORef href
            writeIORef lastOpened t

    --------------------------------------------------------------------------
    loop !d = do
        -- wait on the notification mvar
        _ <- takeMVar notifier

        -- grab the queued messages and write them out
        flushIt d

        -- at least five seconds between log dumps
        threadDelay 5000000
        loop d


------------------------------------------------------------------------------
-- | Kills a logger thread, causing any unwritten contents to be
-- flushed out to disk