Simple logger for R scripts

logger.R

## MIT License

## Copyright (c) 2019 Ryan Moore

## Permission is hereby granted, free of charge, to any person obtaining a copy
## of this software and associated documentation files (the "Software"), to deal
## in the Software without restriction, including without limitation the rights
## to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
## copies of the Software, and to permit persons to whom the Software is
## furnished to do so, subject to the following conditions:

## The above copyright notice and this permission notice shall be included in all
## copies or substantial portions of the Software.

## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
## IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
## FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
## AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
## LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
## OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
## SOFTWARE.

## Set up a Ruby style logger based on https://ruby-doc.org/stdlib-2.5.0/libdoc/logger/rdoc/Logger.html#class-Logger-label-Format.
make_logger <- function(verbosity = 2) {
    ## Lower verbosity means less verbose.  So only messages less than
    ## verbosity level will get printed.  This is a lookup function
    ## for verbosity levels.
    log_level <- function(msg_type) {
        switch(
            msg_type,
            "UNKNOWN" = 1,
            "FATAL" = 1,
            "ERROR" = 1,
            "WARN" = 2,
            "INFO" = 2,
            "DEBUG" = 3,
            3 # default
        )
    }

    ## Expects a valid msg_type.  `msg` can be a format string as it
    ## is passed to sprintf.`...` can be used to pass sprintf style
    ## format string opts.
    log_msg <- function(msg_type, msg, ...) {
        now <- strftime(Sys.time(), format = "%Y-%m-%d %H:%M:%OS6")
        pid <- Sys.getpid()
        msg_code <- substr(msg_type, start = 1, stop = 1)
        msg_prefix <- sprintf(
            "%s, [%s #%d] %s -- ",
            msg_code,
            now,
            pid,
            msg_type
        )

        if (log_level(msg_type) <= verbosity) {
            write(
                paste0(
                    msg_prefix,
                    sprintf(msg, ...)),
                file = stderr())
        }
    }

    structure(
        list(
            unknown = function(msg, ...) {
                log_msg("UNKNOWN", msg, ...)
            },
            fatal = function(msg, ...) {
                log_msg("FATAL", msg, ...)
            },
            error = function(msg, ...) {
                log_msg("ERROR", msg, ...)
            },
            warn = function(msg, ...) {
                log_msg("WARN", msg, ...)
            },
            info = function(msg, ...) {
                log_msg("INFO", msg, ...)
            },
            debug = function(msg, ...) {
                log_msg("DEBUG", msg, ...)
            }
        ),
        class = "logger"
    )
}

opts <- list(verbosity = 3)

logger <- make_logger(opts$verbosity)

logger$unknown("Hi %s", "UNKNOWNNNNN") ## U, [2019-06-20 18:21:28.123598 #18632] UNKNOWN -- Hi UNKNOWNNNNN
logger$fatal("Hi fatal")               ## F, [2019-06-20 18:21:28.150393 #18632] FATAL -- Hi fatal
logger$error("Hi error")               ## E, [2019-06-20 18:21:28.150640 #18632] ERROR -- Hi error
logger$warn("Hi warn")                 ## W, [2019-06-20 18:21:28.150780 #18632] WARN -- Hi warn
logger$info("Hi info")                 ## I, [2019-06-20 18:21:28.150978 #18632] INFO -- Hi info
logger$debug("Hi debug")               ## D, [2019-06-20 18:21:28.151154 #18632] DEBUG -- Hi debug