{-# LANGUAGE PatternSynonyms #-}

{- |
Copyright:  (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module introduces 'Severity' data type for expressing how severe the
message is. Also, it contains useful functions and patterns for work with 'Severity'.


 +-----------+---------+-----------------------------------------+-----------------------------+
 | Severity  | Pattern | Meaning                                 | Example                     |
 +===========+=========+=========================================+=============================+
 | 'Debug'   | 'D'     | Information useful for debug purposes   | Internal function call logs |
 +-----------+---------+-----------------------------------------+-----------------------------+
 | 'Info'    | 'I'     | Normal operational information          | Finish file uploading       |
 +-----------+---------+-----------------------------------------+-----------------------------+
 | 'Warning' | 'W'     | General warnings, non-critical failures | Image load error            |
 +-----------+---------+-----------------------------------------+-----------------------------+
 | 'Error'   | 'E'     | General errors/severe errors            | Could not connect to the DB |
 +-----------+---------+-----------------------------------------+-----------------------------+
-}

module Colog.Core.Severity
       ( Severity (..)
         -- ** Patterns
         -- $pattern
       , pattern D
       , pattern I
       , pattern W
       , pattern E
       , filterBySeverity
       ) where

import Data.Ix (Ix)

import Colog.Core.Action (LogAction (..), cfilter)


-- | Severity for the log messages.
data Severity
    {- | Information useful for debug purposes.

    E.g. output of the function that is important for the internal development,
    not for users. Like, the result of SQL query.
    -}
    = Debug
    {- | Normal operational information.

    E.g. describing general steps: starting application, finished downloading.
    -}
    | Info
    {- | General warnings, non-critical failures.

    E.g. couldn't download icon from some service to display.
    -}
    | Warning
    {- | General errors/severe errors.

    E.g. exceptional situations: couldn't syncronize accounts.
    -}
    | Error
    deriving stock (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
(Int -> ReadS Severity)
-> ReadS [Severity]
-> ReadPrec Severity
-> ReadPrec [Severity]
-> Read Severity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
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 :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord, Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum, Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded, Ord Severity
Ord Severity =>
((Severity, Severity) -> [Severity])
-> ((Severity, Severity) -> Severity -> Int)
-> ((Severity, Severity) -> Severity -> Int)
-> ((Severity, Severity) -> Severity -> Bool)
-> ((Severity, Severity) -> Int)
-> ((Severity, Severity) -> Int)
-> Ix Severity
(Severity, Severity) -> Int
(Severity, Severity) -> [Severity]
(Severity, Severity) -> Severity -> Bool
(Severity, Severity) -> Severity -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Severity, Severity) -> Int
$cunsafeRangeSize :: (Severity, Severity) -> Int
rangeSize :: (Severity, Severity) -> Int
$crangeSize :: (Severity, Severity) -> Int
inRange :: (Severity, Severity) -> Severity -> Bool
$cinRange :: (Severity, Severity) -> Severity -> Bool
unsafeIndex :: (Severity, Severity) -> Severity -> Int
$cunsafeIndex :: (Severity, Severity) -> Severity -> Int
index :: (Severity, Severity) -> Severity -> Int
$cindex :: (Severity, Severity) -> Severity -> Int
range :: (Severity, Severity) -> [Severity]
$crange :: (Severity, Severity) -> [Severity]
$cp1Ix :: Ord Severity
Ix)

{- $pattern
Instead of using full names of the constructors you can instead use one-letter
patterns. To do so you can import and use the pattern:

@
__import__ Colog (__pattern__ D)

example :: WithLog env Message m => m ()
example = log D "I'm using severity pattern"
@

Moreover, you could use patterns when pattern-matching on severity

@
errorToStderr :: 'Severity' -> IO ()
errorToStderr E = hputStrLn stderr "Error severity"
errorToStderr _ = putStrLn "Something else"
@
-}

pattern D, I, W, E :: Severity
pattern $bD :: Severity
$mD :: forall r. Severity -> (Void# -> r) -> (Void# -> r) -> r
D <- Debug   where D = Severity
Debug
pattern $bI :: Severity
$mI :: forall r. Severity -> (Void# -> r) -> (Void# -> r) -> r
I <- Info    where I = Severity
Info
pattern $bW :: Severity
$mW :: forall r. Severity -> (Void# -> r) -> (Void# -> r) -> r
W <- Warning where W = Severity
Warning
pattern $bE :: Severity
$mE :: forall r. Severity -> (Void# -> r) -> (Void# -> r) -> r
E <- Error   where E = Severity
Error
{-# COMPLETE D, I, W, E #-}

-- | Filters messages by the given 'Severity'.
filterBySeverity
    :: Applicative m
    => Severity
    -> (a -> Severity)
    -> LogAction m a
    -> LogAction m a
filterBySeverity :: Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity s :: Severity
s fs :: a -> Severity
fs = (a -> Bool) -> LogAction m a -> LogAction m a
forall (m :: * -> *) msg.
Applicative m =>
(msg -> Bool) -> LogAction m msg -> LogAction m msg
cfilter (\a :: a
a -> a -> Severity
fs a
a Severity -> Severity -> Bool
forall a. Ord a => a -> a -> Bool
>= Severity
s)
{-# INLINE filterBySeverity #-}