Simple, context-rich logging module in Haskell

Logging.hs

module API.Logging (
  -- * Initialize
  mkLog,

  -- * Context, Types
  Context(..),
  Method(..),
  Log,

  -- * Logging
  fatal,
  err,
  warn,
  notice,
  info,
  debug,
  flush,

  -- * Convenience
  (<>)
) where

import Prelude hiding (log)

import Data.Monoid
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format
import Network.HostName
import System.Posix.Process (getProcessID)
import System.Log.FastLogger

type Log = LoggerSet

mkLog :: IO Log
mkLog = newStdoutLoggerSet defaultBufSize

data Context
  = Players
  | Runs
  | Games
  | Login
  | Registration
  | Database
  | Redis

data Method
  = Get
  | Put
  | Post
  | Delete

instance Show Context where
  show Players      = "players"
  show Runs         = "runs"
  show Games        = "games"
  show Login        = "login"
  show Registration = "registration"
  show Database     = "database"
  show Redis        = "redis"

instance Show Method where
  show Get    = "get"
  show Put    = "put"
  show Post   = "post"
  show Delete = "delete"

contextStr :: Context -> Method -> LogStr
contextStr c m = toLogStr (show m) <> "-" <> toLogStr (show c)

log :: ToLogStr m => LogStr -> Log -> Context -> Method -> m -> IO ()
log lv l context' method' m = do
  now <- getCurrentTime
  hname <- fmap toLogStr getHostName
  pid <- (toLogStr . show) <$> getProcessID
  let locale = defaultTimeLocale
  let tForm = "%Y-%m-%dT%H:%M:%SZ"
  let projectName = "tas-api"
  let timestamp = toLogStr (formatTime locale tForm now)
  let ctxt = contextStr context' method'
  pushLogStrLn l $ lv
                 <> ":" <> timestamp
                 <> ":" <> hname
                 <> ":" <> projectName
                 <> ":" <> pid
                 <> ":" <> ctxt
                 <> ":" <> toLogStr m

fatal :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
fatal = log "FATAL"

err :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
err = log "ERROR"

warn :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
warn = log "WARNING"

notice :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
notice = log "NOITCE"

info :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
info = log "INFO"

debug :: ToLogStr m => Log -> Context -> Method -> m -> IO ()
debug = log "DEBUG"

flush :: Log -> IO ()
flush = flushLogStr