what4-1.5.1: Solver-agnostic symbolic values support for issuing queries
Safe HaskellSafe-Inferred
LanguageHaskell2010

What4.Serialize.Log

Description

Log msgs via a synchronized channel.

With inspiration from the monad-logger package.

See examples in Tests.

WARNING: loggers that automatically infer the call stack (via HasCallStack) are not composable, in that they infer a call stack at their call site. So, if you use one to build up another log function, then that derived log function will infer bogus call sites! Of course, it's pretty easy to write

writeLogEvent logCfg level msg

when defining a new logger, so not a big deal, just something to watch out for.

Synopsis

Misc

data LogLevel Source #

Log levels, in increasing severity/precedence order.

Constructors

Debug

Fine details

Info

Tracking progress

Warn

Something notable or suspicious

Error

Something bad

Instances

Instances details
Read LogLevel Source # 
Instance details

Defined in What4.Serialize.Log

Show LogLevel Source # 
Instance details

Defined in What4.Serialize.Log

Eq LogLevel Source # 
Instance details

Defined in What4.Serialize.Log

Ord LogLevel Source # 
Instance details

Defined in What4.Serialize.Log

data LogEvent Source #

A log event.

Can be converted to a string later, or thrown away.

Constructors

LogEvent 

Fields

type HasCallStack = ?callStack :: CallStack #

Request a CallStack.

NOTE: The implicit parameter ?callStack :: CallStack is an implementation detail and should not be considered part of the CallStack API, we may decide to change the implementation in the future.

Since: base-4.9.0.0

Implicit param logger interface

type HasLogCfg = ?logCfg :: LogCfg Source #

Access to the log config.

Users should prefer withLogCfg to binding the implicit param. The implicit param is an implementation detail, and we could change the implementation later, e.g. to use the reflection package.

We use an implicit param to avoid having to change all code in IO that wants to log to be in MonadHasLogCfg and MonadIO classes.

An even more convenient but more "unsafe" implementation would store the LogCfg in a global, unsafePerformIOd IORef (cf. uniqueSource in Unique).

logIO :: (HasLogCfg, HasCallStack, MonadIO m) => LogLevel -> LogMsg -> m () Source #

Log in a MonadIO.

If you want the name of function that called log to be included in the output, then you need to add a HasCallStack constraint to it as well (see LogC). Otherwise, one of two things will happen:

  • if no enclosing function has a HasCallStack constraint, then ??? will be used for the enclosing function name.
  • if at least one enclosing function has a HasCallStack constraint, then the name of the *closest* enclosing function with that constraint will be used for the enclosing function name. So, for example, if you define outer by
outer :: (MonadHasLogCfg m, Ghc.HasCallStack) => m Int
outer = inner
  where
    inner = do
      log Debug "Inside 'inner' ..."
      return 42

then the call to log in inner will have "outer" as the enclosing function name.

logTrace :: (HasLogCfg, HasCallStack) => LogLevel -> LogMsg -> a -> a Source #

Log in pure code using unsafePerformIO, like Trace.

See logIO.

withLogCfg :: LogCfg -> (HasLogCfg => a) -> a Source #

Satisfy a HasLogCfg constraint.

Users can call this function instead of using ImplicitParams themselves.

getLogCfg :: HasLogCfg => LogCfg Source #

Recover the log config.

Useful for going between implicit and monadic interfaces. E.g.

flip runReaderT getLogCfg ...

Explicit parameter logger interface

logIOWith :: (HasCallStack, MonadIO m) => LogCfg -> LogLevel -> LogMsg -> m () Source #

logIO with an explicit config

logEndWith :: LogCfg -> IO () Source #

Signal to the log consumer that there are no more log messages and terminate the log consumer. This is useful for cases where the logger is running in a separate thread and the parent thread wants to wait until the logger has finished logging and has successfully flushed all log messages before terminating it.

writeLogEvent :: LogCfg -> CallStack -> LogLevel -> LogMsg -> IO () Source #

Write a LogEvent to the underlying channel.

This is a low-level function. See logIO, logM, and logTrace for a high-level interface that supplies the LogCfg and CallStack parameters automatically.

However, those functions can't be used to build up custom loggers, since they infer call stack information automatically. If you want to define a custom logger (even something simple like

debug msg = logM Debug msg

) then use writeLogEvent.

Monadic logger interface

class MonadHasLogCfg m where Source #

Monads with logger configuration.

Configuration

data LogCfg Source #

Logging configuration.

mkLogCfg :: String -> IO LogCfg Source #

Initialize a LogCfg.

The first argument is the human friendly name to assign to the current thread. Since logging should be configured as soon as possible on startup, "main" is probably the right name.

See asyncNamed for naming other threads.

Need to start a log event consumer in another thread, e.g. stdErrLogEventConsumer, if you want anything to happen with the log events.

mkNonLogCfg :: IO LogCfg Source #

Initialize a LogCfg that does no logging.

This can be used as a LogCfg when no logging is to be performed. Runtime overhead is smaller when this configuration is specified at compile time.

withLogging :: (MonadUnliftIO m, MonadIO m) => String -> (LogCfg -> IO ()) -> (HasLogCfg => m a) -> m a Source #

Run an action with the given log event consumer.

In particular this provides an easy way to run one-off computations that assume logging, e.g. in GHCi. Spawns the log even consumer before running the action and cleans up the log event consumer afterwards.

Log consumers

stdErrLogEventConsumer :: (LogEvent -> Bool) -> LogCfg -> IO () Source #

A log event consumer that prints formatted log events to stderr.

fileLogEventConsumer :: FilePath -> (LogEvent -> Bool) -> LogCfg -> IO () Source #

A logger that writes to a user-specified file

Note that logs are opened in the w mode (i.e., overwrite). Callers should preserve old log files if they really want.

tmpFileLogEventConsumer :: (LogEvent -> Bool) -> LogCfg -> IO () Source #

A log event consumer that writes formatted log events to a tmp file.

Log formatting and consumption (useful for 3rd-party consumers)

prettyLogEvent :: LogEvent -> String Source #

Format a log event.

consumeUntilEnd :: (LogEvent -> Bool) -> (LogEvent -> IO ()) -> LogCfg -> IO () Source #

Consume a log channel until it receives a shutdown message (i.e. a Nothing).

Only messages that satisfy the predicate will be passed to the continuation. For example, using const True will process all log messages, and using (>= Info) . leLevel will only process messsages with LogLevel equal to Info or higher, ignoring Debug level messages.

Named threads

named :: (MonadUnliftIO m, MonadIO m) => LogCfg -> String -> m a -> m a Source #

Run an IO action with a human friendly thread name.

Any existing thread name will be restored when the action finishes.

namedIO :: (HasLogCfg, MonadUnliftIO m, MonadIO m) => String -> m a -> m a Source #

Version of named for implicit log cfg.

namedM :: (MonadHasLogCfg m, MonadUnliftIO m, MonadIO m) => String -> m a -> m a Source #

Version of named for MonadHasLogCfg monads.