{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module System.FastLogger
  ( Logger
  , timestampedLogEntry
  , combinedLogEntry
  , newLogger
  , newLoggerWithCustomErrorFunction
  , withLogger
  , withLoggerWithCustomErrorFunction
  , stopLogger
  , logMsg
  ) where

------------------------------------------------------------------------------
import           Control.Concurrent               (MVar, ThreadId, killThread, newEmptyMVar, putMVar, takeMVar, threadDelay, tryPutMVar, withMVar)
import           Control.Concurrent.Extended      (forkIOLabeledWithUnmaskBs)
import           Control.Exception                (AsyncException, Handler (..), IOException, SomeException, bracket, catch, catches, mask_)
import           Control.Monad                    (unless, void, when)
import           Data.ByteString.Builder          (Builder, byteString, char8, stringUtf8, toLazyByteString, toLazyByteString)
import           Data.ByteString.Char8            (ByteString)
import qualified Data.ByteString.Char8            as S
import qualified Data.ByteString.Lazy.Char8       as L
import           Data.IORef                       (IORef, newIORef, readIORef, writeIORef)
import           Data.Monoid                      (mappend, mconcat, mempty)
import qualified Data.Text                        as T
import qualified Data.Text.Encoding               as T
import           Data.Word                        (Word64)
import           Prelude                          (Eq (..), FilePath, IO, Int, Maybe, Monad (..), Num (..), Ord (..), Show (..), mapM_, maybe, ($), ($!), (++), (.), (||))
import           System.IO                        (IOMode (AppendMode), hClose, hFlush, openFile, stderr, stdout)
import           System.PosixCompat.Time          (epochTime)
------------------------------------------------------------------------------
import           Snap.Internal.Http.Server.Common (atomicModifyIORef')
import           Snap.Internal.Http.Server.Date   (getLogDateString)


------------------------------------------------------------------------------
-- | Holds the state for a logger.
data Logger = Logger
    { Logger -> IORef Builder
_queuedMessages :: !(IORef Builder)
    , Logger -> MVar ()
_dataWaiting    :: !(MVar ())
    , Logger -> FilePath
_loggerPath     :: !(FilePath)
    , Logger -> MVar ThreadId
_loggingThread  :: !(MVar ThreadId)
    , Logger -> ByteString -> IO ()
_errAction      :: ByteString -> IO ()
    }


------------------------------------------------------------------------------
-- | Creates a new logger, logging to the given file. If the file argument is
-- \"-\", then log to stdout; if it's \"stderr\" then we log to stderr,
-- otherwise we log to a regular file in append mode. The file is closed and
-- re-opened every 15 minutes to facilitate external log rotation.
newLogger :: FilePath                      -- ^ log file to use
          -> IO Logger
newLogger :: FilePath -> IO Logger
newLogger = (ByteString -> IO ()) -> FilePath -> IO Logger
newLoggerWithCustomErrorFunction
              (\ByteString
s -> Handle -> ByteString -> IO ()
S.hPutStr Handle
stderr ByteString
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr)


------------------------------------------------------------------------------
-- | Like 'newLogger', but uses a custom error action if the logger needs to
-- print an error message of its own (for instance, if it can't open the
-- output file.)
newLoggerWithCustomErrorFunction :: (ByteString -> IO ())
                                     -- ^ logger uses this action to log any
                                     -- error messages of its own
                                 -> FilePath   -- ^ log file to use
                                 -> IO Logger
newLoggerWithCustomErrorFunction :: (ByteString -> IO ()) -> FilePath -> IO Logger
newLoggerWithCustomErrorFunction ByteString -> IO ()
errAction FilePath
fp = do
    IORef Builder
q  <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
forall a. Monoid a => a
mempty
    MVar ()
dw <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    MVar ThreadId
th <- IO (MVar ThreadId)
forall a. IO (MVar a)
newEmptyMVar

    let lg :: Logger
lg = IORef Builder
-> MVar ()
-> FilePath
-> MVar ThreadId
-> (ByteString -> IO ())
-> Logger
Logger IORef Builder
q MVar ()
dw FilePath
fp MVar ThreadId
th ByteString -> IO ()
errAction

    IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      ThreadId
tid <- ByteString -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOLabeledWithUnmaskBs ByteString
"snap-server: logging" (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
               Logger -> (forall a. IO a -> IO a) -> IO ()
loggingThread Logger
lg
      MVar ThreadId -> ThreadId -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ThreadId
th ThreadId
tid

    Logger -> IO Logger
forall (m :: * -> *) a. Monad m => a -> m a
return Logger
lg


------------------------------------------------------------------------------
-- | Creates a Logger and passes it into the given function, cleaning up
-- with \"stopLogger\" afterwards.
withLogger :: FilePath                      -- ^ log file to use
          -> (Logger -> IO a)
          -> IO a
withLogger :: FilePath -> (Logger -> IO a) -> IO a
withLogger FilePath
f = IO Logger -> (Logger -> IO ()) -> (Logger -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO Logger
newLogger FilePath
f) Logger -> IO ()
stopLogger


------------------------------------------------------------------------------
-- | Creates a Logger with \"newLoggerWithCustomErrorFunction\" and passes it
-- into the given function, cleaning up with \"stopLogger\" afterwards.
withLoggerWithCustomErrorFunction :: (ByteString -> IO ())
                                     -- ^ logger uses this action to log any
                                     -- error messages of its own
                                  -> FilePath       -- ^ log file to use
                                  -> (Logger -> IO a)
                                  -> IO a
withLoggerWithCustomErrorFunction :: (ByteString -> IO ()) -> FilePath -> (Logger -> IO a) -> IO a
withLoggerWithCustomErrorFunction ByteString -> IO ()
e FilePath
f =
    IO Logger -> (Logger -> IO ()) -> (Logger -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ((ByteString -> IO ()) -> FilePath -> IO Logger
newLoggerWithCustomErrorFunction ByteString -> IO ()
e FilePath
f) Logger -> IO ()
stopLogger


------------------------------------------------------------------------------
-- FIXME: can be a builder, and we could even use the same trick we use for
-- HTTP
--
-- | Prepares a log message with the time prepended.
timestampedLogEntry :: ByteString -> IO ByteString
timestampedLogEntry :: ByteString -> IO ByteString
timestampedLogEntry ByteString
msg = do
    ByteString
timeStr <- IO ByteString
getLogDateString

    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat
           ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$  ByteString -> [ByteString]
L.toChunks
           (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$  Builder -> ByteString
toLazyByteString
           (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Char -> Builder
char8 Char
'['
                      , ByteString -> Builder
byteString ByteString
timeStr
                      , ByteString -> Builder
byteString ByteString
"] "
                      , ByteString -> Builder
byteString ByteString
msg ]


------------------------------------------------------------------------------
-- FIXME: builder
--
-- | Prepares a log message in \"combined\" format.
combinedLogEntry :: ByteString        -- ^ remote host
                 -> Maybe ByteString  -- ^ remote user
                 -> ByteString        -- ^ request line (up to you to ensure
                                      --   there are no quotes in here)
                 -> Int               -- ^ status code
                 -> Word64            -- ^ num bytes sent
                 -> Maybe ByteString  -- ^ referer (up to you to ensure
                                      --   there are no quotes in here)
                 -> ByteString        -- ^ user agent (up to you to ensure
                                      --   there are no quotes in here)
                 -> IO ByteString
combinedLogEntry :: ByteString
-> Maybe ByteString
-> ByteString
-> Int
-> Word64
-> Maybe ByteString
-> ByteString
-> IO ByteString
combinedLogEntry !ByteString
host !Maybe ByteString
mbUser !ByteString
req !Int
status !Word64
numBytes !Maybe ByteString
mbReferer !ByteString
ua = do
    ByteString
timeStr <- IO ByteString
getLogDateString

    let !l :: [Builder]
l = [ ByteString -> Builder
byteString ByteString
host
             , ByteString -> Builder
byteString ByteString
" - "
             , Builder
user
             , ByteString -> Builder
byteString ByteString
" ["
             , ByteString -> Builder
byteString ByteString
timeStr
             , ByteString -> Builder
byteString ByteString
"] \""
             , ByteString -> Builder
byteString ByteString
req
             , ByteString -> Builder
byteString ByteString
"\" "
             , Int -> Builder
forall a. Show a => a -> Builder
fromShow Int
status
             , Builder
space
             , Word64 -> Builder
forall a. Show a => a -> Builder
fromShow Word64
numBytes
             , Builder
space
             , Builder
referer
             , ByteString -> Builder
byteString ByteString
" \""
             , ByteString -> Builder
byteString ByteString
ua
             , Builder
quote ]

    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
l

  where
    dash :: Builder
dash     = Char -> Builder
char8 Char
'-'
    quote :: Builder
quote    = Char -> Builder
char8 Char
'\"'
    space :: Builder
space    = Char -> Builder
char8 Char
' '
    user :: Builder
user     = Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
dash ByteString -> Builder
byteString Maybe ByteString
mbUser
    referer :: Builder
referer  = Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
dash
                     (\ByteString
s -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
quote
                                    , ByteString -> Builder
byteString ByteString
s
                                    , Builder
quote ])
                     Maybe ByteString
mbReferer


------------------------------------------------------------------------------
-- | Sends out a log message verbatim with a newline appended. Note:
-- if you want a fancy log message you'll have to format it yourself
-- (or use 'combinedLogEntry').
logMsg :: Logger -> ByteString -> IO ()
logMsg :: Logger -> ByteString -> IO ()
logMsg !Logger
lg !ByteString
s = do
    let !s' :: Builder
s' = ByteString -> Builder
byteString ByteString
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
char8 Char
'\n'
    IORef Builder -> (Builder -> (Builder, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Logger -> IORef Builder
_queuedMessages Logger
lg) ((Builder -> (Builder, ())) -> IO ())
-> (Builder -> (Builder, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Builder
d -> (Builder
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
s',())
    IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar (Logger -> MVar ()
_dataWaiting Logger
lg) ()


------------------------------------------------------------------------------
loggingThread :: Logger -> (forall a. IO a -> IO a) -> IO ()
loggingThread :: Logger -> (forall a. IO a -> IO a) -> IO ()
loggingThread (Logger IORef Builder
queue MVar ()
notifier FilePath
filePath MVar ThreadId
_ ByteString -> IO ()
errAct) forall a. IO a -> IO a
unmask = do
    IO (IORef Handle, IORef EpochTime)
initialize IO (IORef Handle, IORef EpochTime)
-> ((IORef Handle, IORef EpochTime) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef Handle, IORef EpochTime) -> IO ()
go

  where
    openIt :: IO Handle
openIt =
        if FilePath
filePath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-"
          then Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
          else
            if FilePath
filePath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"stderr"
              then Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stderr
              else FilePath -> IOMode -> IO Handle
openFile FilePath
filePath IOMode
AppendMode IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                     \(IOException
e::IOException) -> do
                       FilePath -> IO ()
logInternalError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't open log file \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                          FilePath
filePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\".\n"
                       FilePath -> IO ()
logInternalError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Exception: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                       FilePath -> IO ()
logInternalError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Logging to stderr instead. " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                          FilePath
"**THIS IS BAD, YOU OUGHT TO " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                          FilePath
"FIX THIS**\n\n"
                       Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stderr

    closeIt :: Handle -> IO ()
closeIt Handle
h = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Handle
h Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
== Handle
stdout Bool -> Bool -> Bool
|| Handle
h Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
== Handle
stderr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Handle -> IO ()
hClose Handle
h

    logInternalError :: FilePath -> IO ()
logInternalError = ByteString -> IO ()
errAct (ByteString -> IO ())
-> (FilePath -> ByteString) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

    --------------------------------------------------------------------------
    go :: (IORef Handle, IORef EpochTime) -> IO ()
go (IORef Handle
href, IORef EpochTime
lastOpened) = IO () -> IO ()
forall a. IO a -> IO a
unmask IO ()
forall b. IO b
loop IO () -> [Handler ()] -> IO ()
forall a. IO a -> [Handler a] -> IO a
`catches`
          [ (AsyncException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((AsyncException -> IO ()) -> Handler ())
-> (AsyncException -> IO ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \(AsyncException
_::AsyncException) -> (IORef Handle, IORef EpochTime) -> IO ()
killit (IORef Handle
href, IORef EpochTime
lastOpened)
          , (SomeException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO ()) -> Handler ())
-> (SomeException -> IO ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \(SomeException
e::SomeException)  -> do
                FilePath -> IO ()
logInternalError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"logger got exception: "
                                   FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
Prelude.show SomeException
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                Int -> IO ()
threadDelay Int
20000000
                (IORef Handle, IORef EpochTime) -> IO ()
go (IORef Handle
href, IORef EpochTime
lastOpened) ]
      where
        loop :: IO b
loop = (IORef Handle, IORef EpochTime) -> IO ()
waitFlushDelay (IORef Handle
href, IORef EpochTime
lastOpened) IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
loop

    --------------------------------------------------------------------------
    initialize :: IO (IORef Handle, IORef EpochTime)
initialize = do
        Handle
lh   <- IO Handle
openIt
        IORef Handle
href <- Handle -> IO (IORef Handle)
forall a. a -> IO (IORef a)
newIORef Handle
lh
        EpochTime
t    <- IO EpochTime
epochTime
        IORef EpochTime
tref <- EpochTime -> IO (IORef EpochTime)
forall a. a -> IO (IORef a)
newIORef EpochTime
t
        (IORef Handle, IORef EpochTime)
-> IO (IORef Handle, IORef EpochTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef Handle
href, IORef EpochTime
tref)


    --------------------------------------------------------------------------
    killit :: (IORef Handle, IORef EpochTime) -> IO ()
killit (IORef Handle
href, IORef EpochTime
lastOpened) = do
        (IORef Handle, IORef EpochTime) -> IO ()
flushIt (IORef Handle
href, IORef EpochTime
lastOpened)
        Handle
h <- IORef Handle -> IO Handle
forall a. IORef a -> IO a
readIORef IORef Handle
href
        Handle -> IO ()
closeIt Handle
h

    --------------------------------------------------------------------------
    flushIt :: (IORef Handle, IORef EpochTime) -> IO ()
flushIt (!IORef Handle
href, !IORef EpochTime
lastOpened) = do
        Builder
dl <- IORef Builder -> (Builder -> (Builder, Builder)) -> IO Builder
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Builder
queue ((Builder -> (Builder, Builder)) -> IO Builder)
-> (Builder -> (Builder, Builder)) -> IO Builder
forall a b. (a -> b) -> a -> b
$ \Builder
x -> (Builder
forall a. Monoid a => a
mempty,Builder
x)

        let !msgs :: ByteString
msgs = Builder -> ByteString
toLazyByteString Builder
dl
        Handle
h <- IORef Handle -> IO Handle
forall a. IORef a -> IO a
readIORef IORef Handle
href
        (do Handle -> ByteString -> IO ()
L.hPut Handle
h ByteString
msgs
            Handle -> IO ()
hFlush Handle
h) IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e::IOException) -> do
                FilePath -> IO ()
logInternalError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"got exception writing to log " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                   FilePath
filePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                FilePath -> IO ()
logInternalError FilePath
"writing log entries to stderr.\n"
                (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> IO ()
errAct ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
msgs

        -- close the file every 15 minutes (for log rotation)
        EpochTime
t   <- IO EpochTime
epochTime
        EpochTime
old <- IORef EpochTime -> IO EpochTime
forall a. IORef a -> IO a
readIORef IORef EpochTime
lastOpened

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EpochTime
tEpochTime -> EpochTime -> EpochTime
forall a. Num a => a -> a -> a
-EpochTime
old EpochTime -> EpochTime -> Bool
forall a. Ord a => a -> a -> Bool
> EpochTime
900) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Handle -> IO ()
closeIt Handle
h
            IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Handle
openIt IO Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef Handle -> Handle -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Handle
href
            IORef EpochTime -> EpochTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef EpochTime
lastOpened EpochTime
t


    waitFlushDelay :: (IORef Handle, IORef EpochTime) -> IO ()
waitFlushDelay !(IORef Handle, IORef EpochTime)
d = do
        -- wait on the notification mvar
        ()
_ <- MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
notifier

        -- grab the queued messages and write them out
        (IORef Handle, IORef EpochTime) -> IO ()
flushIt (IORef Handle, IORef EpochTime)
d

        -- at least five seconds between log dumps
        Int -> IO ()
threadDelay Int
5000000


------------------------------------------------------------------------------
-- | Kills a logger thread, causing any unwritten contents to be
-- flushed out to disk
stopLogger :: Logger -> IO ()
stopLogger :: Logger -> IO ()
stopLogger Logger
lg = MVar ThreadId -> (ThreadId -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Logger -> MVar ThreadId
_loggingThread Logger
lg) ThreadId -> IO ()
killThread


------------------------------------------------------------------------------
fromShow :: Show a => a -> Builder
fromShow :: a -> Builder
fromShow = FilePath -> Builder
stringUtf8 (FilePath -> Builder) -> (a -> FilePath) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show