{- |
Module      : Data.LogSeverity
Description : Syslog-style log message severities
Copyright   : 2018, Automattic, Inc.
License     : BSD3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

Syslog-style log message severities.
-}


{-# LANGUAGE OverloadedStrings #-}
module Data.LogSeverity (
    LogSeverity(..)
  , colorBySeverity
) where

import Data.Text

-- | [Syslog](https://en.wikipedia.org/wiki/Syslog) style log severities.
data LogSeverity
  = LogDebug -- ^ Debug-level messages
  | LogInfo -- ^ Informational messages
  | LogNotice -- ^ Normal but significant condition
  | LogWarning -- ^ Warning conditions
  | LogError -- ^ Error conditions
  | LogCritical -- ^ Critical conditions
  | LogAlert -- ^ Action must be taken immediately
  | LogEmergency -- ^ System is unusable
  deriving (LogSeverity -> LogSeverity -> Bool
(LogSeverity -> LogSeverity -> Bool)
-> (LogSeverity -> LogSeverity -> Bool) -> Eq LogSeverity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogSeverity -> LogSeverity -> Bool
$c/= :: LogSeverity -> LogSeverity -> Bool
== :: LogSeverity -> LogSeverity -> Bool
$c== :: LogSeverity -> LogSeverity -> Bool
Eq, Eq LogSeverity
Eq LogSeverity
-> (LogSeverity -> LogSeverity -> Ordering)
-> (LogSeverity -> LogSeverity -> Bool)
-> (LogSeverity -> LogSeverity -> Bool)
-> (LogSeverity -> LogSeverity -> Bool)
-> (LogSeverity -> LogSeverity -> Bool)
-> (LogSeverity -> LogSeverity -> LogSeverity)
-> (LogSeverity -> LogSeverity -> LogSeverity)
-> Ord LogSeverity
LogSeverity -> LogSeverity -> Bool
LogSeverity -> LogSeverity -> Ordering
LogSeverity -> LogSeverity -> LogSeverity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogSeverity -> LogSeverity -> LogSeverity
$cmin :: LogSeverity -> LogSeverity -> LogSeverity
max :: LogSeverity -> LogSeverity -> LogSeverity
$cmax :: LogSeverity -> LogSeverity -> LogSeverity
>= :: LogSeverity -> LogSeverity -> Bool
$c>= :: LogSeverity -> LogSeverity -> Bool
> :: LogSeverity -> LogSeverity -> Bool
$c> :: LogSeverity -> LogSeverity -> Bool
<= :: LogSeverity -> LogSeverity -> Bool
$c<= :: LogSeverity -> LogSeverity -> Bool
< :: LogSeverity -> LogSeverity -> Bool
$c< :: LogSeverity -> LogSeverity -> Bool
compare :: LogSeverity -> LogSeverity -> Ordering
$ccompare :: LogSeverity -> LogSeverity -> Ordering
$cp1Ord :: Eq LogSeverity
Ord, Int -> LogSeverity -> ShowS
[LogSeverity] -> ShowS
LogSeverity -> String
(Int -> LogSeverity -> ShowS)
-> (LogSeverity -> String)
-> ([LogSeverity] -> ShowS)
-> Show LogSeverity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogSeverity] -> ShowS
$cshowList :: [LogSeverity] -> ShowS
show :: LogSeverity -> String
$cshow :: LogSeverity -> String
showsPrec :: Int -> LogSeverity -> ShowS
$cshowsPrec :: Int -> LogSeverity -> ShowS
Show)

-- | Pretty prints a simple log header.
colorBySeverity
  :: LogSeverity
  -> Text -- ^ Printed before the severity label; i.e. a timestamp
  -> Text
colorBySeverity :: LogSeverity -> Text -> Text
colorBySeverity LogSeverity
severity Text
msg = case LogSeverity
severity of
  LogSeverity
LogDebug     -> Text
"\x1b[1;32m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" DEBUG \x1b[0;39;49m"
  LogSeverity
LogInfo      -> Text
"\x1b[1;32m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" INFO \x1b[0;39;49m"
  LogSeverity
LogNotice    -> Text
"\x1b[1;34m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" NOTICE \x1b[0;39;49m"
  LogSeverity
LogWarning   -> Text
"\x1b[1;33m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WARNING \x1b[0;39;49m"
  LogSeverity
LogError     -> Text
"\x1b[1;31m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ERROR \x1b[0;39;49m"
  LogSeverity
LogCritical  -> Text
"\x1b[1;31m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" CRITICAL \x1b[0;39;49m"
  LogSeverity
LogAlert     -> Text
"\x1b[1;35m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ALERT \x1b[0;39;49m"
  LogSeverity
LogEmergency -> Text
"\x1b[1;35m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" EMERGENCY \x1b[0;39;49m"