{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-}

-- | This module contains types and functions for log message severities.
module System.Log.Heavy.Level
  ( -- * Data types
   Level (..),
   -- * Utility functions
   levelToLogLevel, logLevelToLevel,
   parseLevel,
   -- * Standard severity levels
   trace_level, debug_level, info_level, warn_level, error_level, fatal_level,
   disable_logging
  ) where

import Control.Monad.Logger (LogLevel (..))
import qualified Data.Text as T
import qualified System.Posix.Syslog as Syslog

-- | Logging message severity level data type
data Level = Level {
    Level -> Text
levelName :: T.Text            -- ^ Level name, like @"debug"@ or @"info"@
  , Level -> Int
levelInt :: Int                -- ^ Integer level identifier. Comparation is based on these identifiers.
  , Level -> Priority
levelToPriority :: Syslog.Priority -- ^ Syslog equivalent of this level.
  } deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq)

instance Show Level where
  show :: Level -> String
show Level
l = Text -> String
T.unpack (Level -> Text
levelName Level
l)

instance Ord Level where
  compare :: Level -> Level -> Ordering
compare Level
l1 Level
l2 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Level -> Int
levelInt Level
l1) (Level -> Int
levelInt Level
l2)

-- | TRACE level is supposed to be used for development-stage debugging.
-- Has integer value of 600.
trace_level :: Level
trace_level :: Level
trace_level = Text -> Int -> Priority -> Level
Level Text
"TRACE" Int
600 Priority
Syslog.Debug

-- | DEBUG level is supposed to be used for debug logging that can be
-- enabled on production.
-- Has integer value of 500.
debug_level :: Level
debug_level :: Level
debug_level = Text -> Int -> Priority -> Level
Level Text
"DEBUG" Int
500 Priority
Syslog.Debug

-- | INFO level: some event occured.
-- Has integer value of 400.
info_level :: Level
info_level :: Level
info_level = Text -> Int -> Priority -> Level
Level Text
"INFO" Int
400 Priority
Syslog.Info

-- | WARN level: something went wrong, but for now it will not affect
-- system's stability.
-- Has integer value of 300.
warn_level :: Level
warn_level :: Level
warn_level = Text -> Int -> Priority -> Level
Level Text
"WARN" Int
300 Priority
Syslog.Warning

-- | ERROR level: something went wrong.
-- Has integer value of 200.
error_level :: Level
error_level :: Level
error_level = Text -> Int -> Priority -> Level
Level Text
"ERROR" Int
200 Priority
Syslog.Error

-- | FATAL level: something went terribly wrong, application is to be stopped.
-- Has integer value of 100.
fatal_level :: Level
fatal_level :: Level
fatal_level = Text -> Int -> Priority -> Level
Level Text
"FATAL" Int
100 Priority
Syslog.Emergency

-- | DISABLED level. This has integer identifier of 0, which is supposed to
-- be less than any other level. This value can be used to disable logging at
-- all.
disable_logging :: Level
disable_logging :: Level
disable_logging = Text -> Int -> Priority -> Level
Level Text
"DISABLED" Int
0 Priority
Syslog.Emergency

-- | Conversion function
levelToLogLevel :: Level -> LogLevel
levelToLogLevel :: Level -> LogLevel
levelToLogLevel Level
l =
  case Level -> Text
levelName Level
l of
    Text
"DEBUG" -> LogLevel
LevelDebug
    Text
"INFO"  -> LogLevel
LevelInfo
    Text
"WARN"  -> LogLevel
LevelWarn
    Text
"ERROR" -> LogLevel
LevelError
    Text
name -> Text -> LogLevel
LevelOther Text
name

-- | Convertion function. Note that @LevelOther@ is
-- translated to integer level 210 and Syslog's Alert priority,
-- since in @monad-logger@ semantics any LevelOther is more severe
-- than LevelError.
logLevelToLevel :: LogLevel -> Level
logLevelToLevel :: LogLevel -> Level
logLevelToLevel LogLevel
LevelDebug = Level
debug_level
logLevelToLevel LogLevel
LevelInfo  = Level
info_level
logLevelToLevel LogLevel
LevelWarn  = Level
warn_level
logLevelToLevel LogLevel
LevelError = Level
error_level
logLevelToLevel (LevelOther Text
name) = Text -> Int -> Priority -> Level
Level Text
name Int
210 Priority
Syslog.Alert

-- | Detect @Level@ from it's name. This function
-- is not case-sensitive.
parseLevel :: [Level] -- ^ List of recognized levels
           -> T.Text  -- ^ Level name to find
           -> Maybe Level -- ^ Nothing if no match found
parseLevel :: [Level] -> Text -> Maybe Level
parseLevel [Level]
knownLevels Text
str = [Level] -> Maybe Level
go [Level]
knownLevels
  where
    go :: [Level] -> Maybe Level
go [] = Maybe Level
forall a. Maybe a
Nothing
    go (Level
l:[Level]
ls)
      | Text -> Text
T.toCaseFold (Level -> Text
levelName Level
l) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
needle = Level -> Maybe Level
forall a. a -> Maybe a
Just Level
l
      | Bool
otherwise = [Level] -> Maybe Level
go [Level]
ls

    needle :: Text
needle = Text -> Text
T.toCaseFold Text
str