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

    -- * Functions for composing formatters
  , (%), (%+)

    -- * Message formatting functions
  , sev, sevc, stack, stackc, msg, msgc

    -- * Other functions
  , colorize
  , setSeverity

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

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

    -- * Deprecated message formatting functions
  , basicFmt, colorFmt, colorSevFmt, colorSevStackFmt
  )
  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


-- | 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)


-- | 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    = "[Debug]   "
showSeverity Info     = "[Info]    "
showSeverity Notice   = "[Notice]  "
showSeverity Warning  = "[Warning] "
showSeverity Error    = "[Error]   "


colorForSeverity :: Severity -> Color
colorForSeverity Debug = Green
colorForSeverity Info = Blue
colorForSeverity Notice = White
colorForSeverity Warning = Yellow
colorForSeverity Error = Red


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


-- | Apply two formatters to a 'Message' and combine the resulting 'Text's.
--   With apologies to the formatting library for stealing their operator!
(%) :: Formatter -> Formatter -> Formatter
f % g = \msg' -> f msg' <> g msg'


-- | Apply two formatters to a 'Message' and combine the resulting 'Text'
--   output with a space between.
--   Again, with apologies to the formatting library for stealing their operator!
(%+) :: Formatter -> Formatter -> Formatter
f %+ g = f % const " " % g


-- | Format 'Severity'
sev :: Message -> Text
sev (Msg s _ _) = showSeverity s


-- | Format 'Severity' with color based on the value
sevc :: Message -> Text
sevc (Msg s _ _) = colorize (colorForSeverity s) $ showSeverity s


-- | Format call stack info
stack :: Message -> Text
stack (Msg _ cs _) = showSourceLoc cs


-- | Format call stack info with color based on the 'Severity'
stackc :: Message -> Text
stackc (Msg s cs _) = colorize (colorForSeverity s) $ showSourceLoc cs


-- | Format the log message
msg :: Message -> Text
msg (Msg _ _ m) = m


-- | Format the log message with color based on the 'Severity'
msgc :: Message -> Text
msgc (Msg s _ m) = colorize (colorForSeverity s) m


-- | 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)


-- | No color formatting. Just the message, no severity label
basicFmt :: Message -> Text
basicFmt = msg
{-# DEPRECATED basicFmt "Use msg instead" #-}


-- | Format with no severity labels but message colors for each severity
colorFmt :: Message -> Text
colorFmt = msgc
{-# DEPRECATED colorFmt "Use msgc instead" #-}


-- | Format with colored severity labels and no color for the message
colorSevFmt :: Message -> Text
colorSevFmt = sevc % msg
{-# DEPRECATED colorSevFmt "Use (sevc % msgc) instead" #-}


-- | Format with colored severity labels, call stack info, and no color for the
--   message
colorSevStackFmt :: Message -> Text
colorSevStackFmt = sevc % stack %+ msg
{-# DEPRECATED colorSevStackFmt "Use (sevc % stack %+ msgc) instead" #-}