F# Idiomatic Log4Net Wrapper

Question

I put together a log4net wrapper that more closely resembles F#-idiomatic logging functions. The basic idea is that there's a Log module that defines a set of 8 functions for each log level, as in the following example for the Error log level:

Log.error - Log a message (string) with the Error log level

Log.errorf - Log a formatted message (like printf) with the Error log level

Log.errorx - Log an Exception and a message with the Error log level

Log.errorxf - Log an Exception and a formatted message (like printf) with the Error log level

Log.errorr - Log a message (string) with the Error log level, then return the message

Log.errorfr - Format and log a message with the Error log level, then return the formatted message

Log.errorxr - Log an Exception and message with the Error log level, then return the message

Log.errorxfr - Log an Exception and a formatted message with the Error log level, then return the formatted message

The biggest issue I had when implementing this wrapper was with getting the proper Stack Trace to show up in the log4net output. To match the behavior of using the standard log4net client in a C# application, I had to inline all the logging functions, as well as as reflectively mutate the m_stackFrames member of the log4net LocationInfo object.

let private writeLog level message maybeEx logDate (stackTrace: StackTrace) = 
    let user = Threading.Thread.CurrentPrincipal.Identity
    let topFrame = stackTrace.GetFrame(0)
    let callingMethod = topFrame.GetMethod()
    let location = LocationInfo(callingMethod.DeclaringType.FullName, callingMethod.Name,
        callingMethod.DeclaringType.Name, String.Empty)

    typeof<LocationInfo>
        .GetField("m_stackFrames", BindingFlags.Instance ||| BindingFlags.NonPublic)
        .SetValue(location, stackTrace.GetFrames() |> Array.map StackFrameItem)

    // ...etc (complete code below)

I really don't like this solution, as it is tightly coupled to the private member name in the log4net code, which could change with any new release. However, I could not see a better way to do it, since the LocationInfo object does not have a constructor overload that accepts the stack trace as a parameter, and the field is private readonly in the C# code.

I'd be happy to hear any suggestions on how to improve this part of the code, as well as any general improvements for the logging functions or ways to make them more idiomatic. The complete wrapper code is as follows:

open log4net
open log4net.Core
open System
open System.Diagnostics
open System.Reflection

[<RequireQualifiedAccess>]
module Logger =
    let private log = lazy(
        log4net.Config.XmlConfigurator.Configure() |> ignore
        LogManager.GetLogger("Logger"))

    let GetLogger () = log.Value.Logger

[<RequireQualifiedAccess>]
module Log =
    type LoggedException (message, ex: Exception) = inherit Exception(message, ex)    
    let private logger = Logger.GetLogger()

    [<Struct>]
    type LogInfo =
        {
            Message: string
            Error: exn option
            Date: DateTime
            StackTrace: StackTrace
        }

    type LogMessage = 
    | Debug of LogInfo
    | Info of LogInfo
    | Warning of LogInfo
    | Error of LogInfo
    | Fatal of LogInfo
        member this.Message = 
            match this with
            | Debug info -> info.Message
            | Info info -> info.Message
            | Warning info -> info.Message
            | Error info -> info.Message
            | Fatal info -> info.Message
        member this.Exception =
            match this with
            | Debug info -> info.Error
            | Info info -> info.Error
            | Warning info -> info.Error
            | Error info -> info.Error
            | Fatal info -> info.Error

    let private writeLog level message maybeEx logDate (stackTrace: StackTrace) = 
        let user = Threading.Thread.CurrentPrincipal.Identity
        let topFrame = stackTrace.GetFrame(0)
        let callingMethod = topFrame.GetMethod()
        let location = LocationInfo(callingMethod.DeclaringType.FullName, callingMethod.Name, callingMethod.DeclaringType.Name, String.Empty)

        // Correctly populate the read-only Location.StackFrames property by reflectively assigning the underlying m_stackFrames member.
        // In .NET, private readonly fields can still be mutated at run-time.  This is not the ideal solution and may be implementaiton-specific,
        // but for now, this should work, and it's the only way to get the Stack Trace information into the log message when constructing
        // the LoggingEvent manually from F# (since F# does not fully support the CallerMemberName attribute that log4net uses in C#).
        typeof<LocationInfo>
            .GetField("m_stackFrames", BindingFlags.Instance ||| BindingFlags.NonPublic)
            .SetValue(location, stackTrace.GetFrames() |> Array.map StackFrameItem)

        match maybeEx with
        | Some ex ->             
            let logData = new LoggingEventData(Domain = AppDomain.CurrentDomain.FriendlyName, Level = level, LocationInfo = location, Message = message, TimeStamp = logDate, LoggerName = "Logger", Identity = user.Name, UserName = user.Name, ExceptionString = ex.ToString())
            let logEvent = new LoggingEvent(logData)
            logger.Log(logEvent)
        | None -> 
            let logData = new LoggingEventData(Domain = AppDomain.CurrentDomain.FriendlyName, Level = level, LocationInfo = location, Message = message, TimeStamp = logDate, LoggerName = "Logger", Identity = user.Name, UserName = user.Name)
            let logEvent = new LoggingEvent(logData)
            logger.Log(logEvent)

    let logAgent = MailboxProcessor.Start <| fun inbox -> 
        let rec logLoop () = async {
            let! message = inbox.Receive()            
            match message with
            | Debug info -> writeLog Level.Debug info.Message info.Error info.Date info.StackTrace
            | Info info -> writeLog Level.Info info.Message info.Error info.Date info.StackTrace
            | Warning info -> writeLog Level.Warn info.Message info.Error info.Date info.StackTrace
            | Error info -> writeLog Level.Error info.Message info.Error info.Date info.StackTrace
            | Fatal info -> writeLog Level.Fatal info.Message info.Error info.Date info.StackTrace
            return! logLoop()
        }
        logLoop ()

    let inline postAndReturn logMessage =
        logAgent.Post logMessage
        logMessage.Message

    let inline postAndRaise logMessage =
        logAgent.Post logMessage
        match logMessage.Exception with
        | Some ex -> LoggedException(logMessage.Message, ex)
        | None -> LoggedException(logMessage.Message, null)

    let inline log messageType = (messageType >> logAgent.Post)
    let inline logr messageType = (messageType >> postAndReturn)
    let inline logf messageType = Printf.kprintf (messageType >> logAgent.Post)
    let inline logfr messageType = Printf.kprintf (messageType >> postAndReturn)
    let inline logxr messageType = (messageType >> postAndRaise)
    let inline logxfr messageType = Printf.kprintf (messageType >> postAndRaise)

    let inline debug message = 
        let stackTrace = StackTrace()
        Debug {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> logAgent.Post

    let inline debugf format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Debug {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline debugx ex = 
        let stackTrace = StackTrace()
        log <| fun message -> Debug {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline debugxf ex format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Debug {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline debugr message = 
        let stackTrace = StackTrace()
        Debug {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> postAndReturn

    let inline debugfr format args = 
        let stackTrace = StackTrace()
        logfr (fun message -> Debug {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline debugxr ex = 
        let stackTrace = StackTrace()
        logxr <| fun message -> Debug {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline debugxfr ex format args = 
        let stackTrace = StackTrace()
        logxfr (fun message -> Debug {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline info message = 
        let stackTrace = StackTrace()
        Info {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> logAgent.Post

    let inline infof format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Info {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline infox ex = 
        let stackTrace = StackTrace()
        log <| fun message -> Info {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline infoxf ex format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Info {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline infor message = 
        let stackTrace = StackTrace()
        Info {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> postAndReturn

    let inline infofr format args = 
        let stackTrace = StackTrace()
        logfr (fun message -> Info {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline infoxr ex = 
        let stackTrace = StackTrace()
        logxr <| fun message -> Info {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline infoxfr ex format args = 
        let stackTrace = StackTrace()
        logxfr (fun message -> Info {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline warn message = 
        let stackTrace = StackTrace()
        Warning {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> logAgent.Post

    let inline warnf format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Warning {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline warnx ex = 
        let stackTrace = StackTrace()
        log <| fun message -> Warning {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline warnxf ex format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Warning {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline warnr message = 
        let stackTrace = StackTrace()
        Warning {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> postAndReturn

    let inline warnfr format args = 
        let stackTrace = StackTrace()
        logfr (fun message -> Warning {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline warnxr ex = 
        let stackTrace = StackTrace()
        logxr <| fun message -> Warning {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline warnxfr ex format args = 
        let stackTrace = StackTrace()
        logxfr (fun message -> Warning {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args     

    let inline error message = 
        let stackTrace = StackTrace()
        Error {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> logAgent.Post

    let inline errorf format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Error {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline errorx ex = 
        let stackTrace = StackTrace()
        log <| fun message -> Error {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline errorxf ex format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Error {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline errorr message = 
        let stackTrace = StackTrace()
        Error {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> postAndReturn

    let inline errorfr format args = 
        let stackTrace = StackTrace()
        logfr (fun message -> Error {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline errorxr ex = 
        let stackTrace = StackTrace()
        logxr <| fun message -> Error {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline errorxfr ex format args = 
        let stackTrace = StackTrace()
        logxfr (fun message -> Error {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline fatal message = 
        let stackTrace = StackTrace()
        Fatal {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> logAgent.Post

    let inline fatalf format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Fatal {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline fatalx ex = 
        let stackTrace = StackTrace()
        log <| fun message -> Fatal {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline fatalxf ex format args = 
        let stackTrace = StackTrace()
        logf (fun message -> Fatal {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline fatalr message = 
        let stackTrace = StackTrace()
        Fatal {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}
        |> postAndReturn

    let inline fatalfr format args = 
        let stackTrace = StackTrace()
        logfr (fun message -> Fatal {Message = message; Error = None; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

    let inline fatalxr ex = 
        let stackTrace = StackTrace()
        logxr <| fun message -> Fatal {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}

    let inline fatalxfr ex format args = 
        let stackTrace = StackTrace()
        logxfr (fun message -> Fatal {Message = message; Error = Some ex; Date = DateTime.UtcNow; StackTrace = stackTrace}) format args

Answer 1

Your design doesn't make sense, to me.

[<Struct>]
type LogInfo =
    {
        Message: string
        Error: exn option
        Date: DateTime
        StackTrace: StackTrace
    }

type LogMessage = 
| Debug of LogInfo
| Info of LogInfo
| Warning of LogInfo
| Error of LogInfo
| Fatal of LogInfo
    member this.Message = 
        match this with
        | Debug info -> info.Message
        | Info info -> info.Message
        | Warning info -> info.Message
        | Error info -> info.Message
        | Fatal info -> info.Message
    member this.Exception =
        match this with
        | Debug info -> info.Error
        | Info info -> info.Error
        | Warning info -> info.Error
        | Error info -> info.Error
        | Fatal info -> info.Error

This looks backwards. Instead of the LogMessage being a DU, make it an enumeration and a value on the LogInfo record:

type MessageType = | Debug | Info | Warning | Error | Fatal
type LogInfo = {
    Message : string
    Error : exn option
    Date : DateTime
    StackTrace : StackTrace
    Type : MessageType
}

Then you can just drop into LogInfo.Message or LogInfo.Error.

Additionally, the design still doesn't make sense as much as I'd think it would, because Error really shouldn't be a property of the record, but should be a union case:

type MessageType = | Debug | Info | Warning | Error | Fatal
type LogInfo = {
    Message : string
    Date : DateTime
    Type : MessageType
}
type ErrorInfo = {
    Error : exn
    StackTrace : StackTrace
}
type LogMessage =
    | Error of ErrorInfo * LogInfo
    | Standard of LogInfo
    member this.Message =
        match this with | Error (_, i) | Standard i -> i.Message
    member this.Exception =
        match this with | Error (e, _) -> Some e.Error | _ -> None

This makes more sense to me, because it means we can represent the LogMessage for what it is: an Error or a Standard message. Additionally, I'd consider splitting out the cases at this point to represent the valid states as a DU now that we know what they are:

type LogInfo = {
    Message : string
    Date : DateTime
}
type ErrorInfo = {
    Error : exn
    StackTrace : StackTrace
}

type LogMessage =
    | Debug of LogInfo
    | Info of LogInfo
    | Warning of LogInfo
    | Error of ErrorInfo * LogInfo
    | Fatal of ErrorInfo * LogInfo
    member this.Message =
        match this with | Debug i | Info i | Warning i | Error (_, i) | Fatal (_, i) -> i.Message
    member this.Exception =
        match this with | Error (e, _) | Fatal (e, _) -> Some e.Error | _ -> None

There, that looks better.

I don't know why you put the StackTrace on the LogInfo member, I would think you only care in the case of an exception (typically getting the stack trace is the longest part of this type of thing), but if you absolutely need it on all messages then you can simply move it back.

A couple of fun-facts about F#:

• When matching DU's / Records, if you include multiple matches with the same alias with the same type (| Debug i | Info i) you can have one handler for them:

  match this with | Debug i | Info i | Warning i | Error (_, i) | Fatal (_, i) -> i.Message
  

• It's subjective, but I like to format records in a single line, or with the Java-style braces when opening:

  let LogInfo = {
  

Using those tricks, we can take:

let logAgent = MailboxProcessor.Start <| fun inbox -> 
    let rec logLoop () = async {
        let! message = inbox.Receive()            
        match message with
        | Debug info -> writeLog Level.Debug info.Message info.Error info.Date info.StackTrace
        | Info info -> writeLog Level.Info info.Message info.Error info.Date info.StackTrace
        | Warning info -> writeLog Level.Warn info.Message info.Error info.Date info.StackTrace
        | Error (err, info) -> writeLog Level.Error info.Message info.Error info.Date info.StackTrace
        | Fatal (err, info) -> writeLog Level.Fatal info.Message info.Error info.Date info.StackTrace
        return! logLoop()
    }
    logLoop ()

And rewrite it with a little less duplication, keeping things concise and readable:

let logAgent = MailboxProcessor.Start <| fun inbox -> 
    let rec logLoop () = async {
        let! message = inbox.Receive()       
        let level, info, error =
            match message with
            | Debug info -> Level.Debug, info, None
            | Info info -> Level.Info, info, None
            | Warning info -> Level.Warn, info, None
            | Error (err, info) -> Level.Error, info, (Some err.Error)
            | Fatal (err, info) -> Level.Fatal, info, (Some err.Error)
        writeLog level info.Message error info.Date info.StackTrace
        return! logLoop()
    }
    logLoop ()

But at this point I find myself asking "why have this.Message or this.Exceptoin on the LogMessage?" We don't use them.

So with that thought, why not add a this.Level and this.Info and make life a lot easier?

type LogMessage =
    | Debug of LogInfo
    | Info of LogInfo
    | Warning of LogInfo
    | Error of ErrorInfo * LogInfo
    | Fatal of ErrorInfo * LogInfo
    member this.Message =
        match this with | Debug i | Info i | Warning i | Error (_, i) | Fatal (_, i) -> i.Message
    member this.Exception =
        match this with | Error (e, _) | Fatal (e, _) -> Some e.Error | _ -> None
    member this.Level =
        match this with | Debug _ -> Level.Debug | Info _ -> Level.Info | Warning _ -> Level.Warn | Error _ -> Level.Error | Fatal _ -> Level.Fatal
    member this.LogInfo =
        match this with | Debug i | Info i | Warning i | Error (_, i) | Fatal (_, i) -> i

let logAgent = MailboxProcessor.Start <| fun inbox -> 
    let rec logLoop () = async {
        let! (message : LogMessage) = inbox.Receive()
        writeLog message.Level message.LogInfo.Message message.Exception message.LogInfo.Date message.LogInfo.StackTrace
        return! logLoop()
    }
    logLoop ()

Sure we'll have multiple match expressions, but that's the price to pay for OOP-F#. If we did it entirely functionally, we would remove those members and put the entire burden on the caller.

I guess all this info exists to say that typically, in something like this, we can evaluate different options and come up with a domain representation that makes things easier to use, more representative, and more fool-proof. (Especially with people like me, who can break anything.)