Message.hs

{-|
The workhorse module of this library. Here you will find types for working with
this logging library along with functions for issuing log messages of various
severities. Also in this module are a small set of basic log output formatters.
-}
module Colog.Simple.Message
  (
    -- * Types
    Formatter
  , Message

    -- * Functions for logging with a specific severity
  , logDebug, logInfo, logNotice, logWarning, logError

    -- * Message formatting functions
  , basicFmt, colorFmt, colorSevFmt, colorSevStackFmt

    -- * Other functions
  , colorize
  , setSeverity

    -- * Re-exported from ansi-terminal
  , Color (..)

    -- * Re-exported from co-log
  , Msg (..)
  )
  where

import Colog (LogAction, cfilter)
import Colog.Message (Msg (..), log, showSourceLoc)
import Colog.Monad (WithLog)
import Data.Text (Text, pack)
import GHC.Stack (withFrozenCallStack)
import Prelude hiding (log)
import System.Console.ANSI (Color (..), ColorIntensity (Vivid),
  ConsoleLayer (Foreground), SGR (..), setSGRCode)

import Colog.Simple.Severity (Severity (..))


-- | The type of a 'Msg' parameterized with the custom severity type in this
--   library
type Message = Msg Severity

-- | The type of functions which format 'Message's into 'Text'
type Formatter = Message -> Text


-- | Wrap some 'Text' in the ANSI codes to color it in a terminal
colorize :: Color -> Text -> Text
colorize c txt =
  pack (setSGRCode [SetColor Foreground Vivid c])
  <> txt
  <> pack (setSGRCode [Reset])


showSeverity :: Severity -> Text
showSeverity Debug    = colorize Green  "[Debug]   "
showSeverity Info     = colorize Blue   "[Info]    "
showSeverity Notice   = colorize White  "[Notice]  "
showSeverity Warning  = colorize Yellow "[Warning] "
showSeverity Error    = colorize Red    "[Error]   "


-- | Log a message with 'Debug' severity
logDebug :: WithLog env Message m => Text -> m ()
logDebug = withFrozenCallStack (log Debug)


-- | Log a message with 'Info' severity
logInfo :: WithLog env Message m => Text -> m ()
logInfo = withFrozenCallStack (log Info)


-- | Log a message with 'Notice' severity
logNotice :: WithLog env Message m => Text -> m ()
logNotice = withFrozenCallStack (log Notice)


-- | Log a message with 'Warning' severity
logWarning :: WithLog env Message m => Text -> m ()
logWarning = withFrozenCallStack (log Warning)


-- | Log a message with 'Error' severity
logError :: WithLog env Message m => Text -> m ()
logError = withFrozenCallStack (log Error)


-- | No color formatting. Just the message, no severity label
basicFmt :: Formatter
basicFmt (Msg _ _ txt) = txt


-- | Format with no severity labels but message colors for each severity
colorFmt :: Formatter
colorFmt (Msg Debug _ txt) = colorize Green txt
colorFmt (Msg Info _ txt) = colorize Blue txt
colorFmt (Msg Notice _ txt) = colorize White txt
colorFmt (Msg Warning _ txt) = colorize Yellow txt
colorFmt (Msg Error _ txt) = colorize Red txt


-- | Format with colored severity labels and no color for the message
colorSevFmt :: Formatter
colorSevFmt (Msg sev _ txt) = showSeverity sev <> txt


-- | Format with colored severity labels, call stack info, and no color for the
--   message
colorSevStackFmt :: Formatter
colorSevStackFmt (Msg sev cs txt) = showSeverity sev <> showSourceLoc cs <> txt


-- | Filter log messages for greater than or equal to the given 'Severity'
setSeverity :: Applicative m => Severity -> LogAction m Message -> LogAction m Message
setSeverity targetSev = cfilter (\(Msg msgSev _ _) -> msgSev >= targetSev)