{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Plow.Logging.Message
  ( LogLevel (..),
    LogMessage (..),
  )
where

import Data.Aeson (FromJSON (parseJSON), ToJSON, withText)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
import Plow.Logging (HasEnumerableConstructors)

-- | Generic log levels
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
  deriving (LogLevel -> LogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
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 :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
Ord, forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogLevel x -> LogLevel
$cfrom :: forall x. LogLevel -> Rep LogLevel x
Generic, Proxy LogLevel -> [String]
LogLevel -> [String]
forall a.
(a -> [String])
-> (Proxy a -> [String]) -> HasEnumerableConstructors a
allConstructors :: Proxy LogLevel -> [String]
$callConstructors :: Proxy LogLevel -> [String]
listConstructors :: LogLevel -> [String]
$clistConstructors :: LogLevel -> [String]
HasEnumerableConstructors, [LogLevel] -> Encoding
[LogLevel] -> Value
LogLevel -> Encoding
LogLevel -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LogLevel] -> Encoding
$ctoEncodingList :: [LogLevel] -> Encoding
toJSONList :: [LogLevel] -> Value
$ctoJSONList :: [LogLevel] -> Value
toEncoding :: LogLevel -> Encoding
$ctoEncoding :: LogLevel -> Encoding
toJSON :: LogLevel -> Value
$ctoJSON :: LogLevel -> Value
ToJSON)

instance Show LogLevel where
  show :: LogLevel -> String
show LogLevel
LevelDebug = String
"DEBUG"
  show LogLevel
LevelInfo = String
"INFO"
  show LogLevel
LevelWarn = String
"WARN"
  show LogLevel
LevelError = String
"ERROR"
  show (LevelOther Text
l) = Text -> String
Text.unpack Text
l

instance FromJSON LogLevel where
  parseJSON :: Value -> Parser LogLevel
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LogLevel" forall a b. (a -> b) -> a -> b
$ \case
    Text
"DEBUG" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
LevelDebug
    Text
"INFO" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
LevelInfo
    Text
"WARN" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
LevelWarn
    Text
"ERROR" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
LevelError
    Text
other -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> LogLevel
LevelOther Text
other

-- | A log message that allows for a log level to be specified or for the log
-- to be ignored.
data LogMessage a
  = Stdout LogLevel a
  | Ignore
  deriving (Int -> LogMessage a -> ShowS
forall a. Show a => Int -> LogMessage a -> ShowS
forall a. Show a => [LogMessage a] -> ShowS
forall a. Show a => LogMessage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage a] -> ShowS
$cshowList :: forall a. Show a => [LogMessage a] -> ShowS
show :: LogMessage a -> String
$cshow :: forall a. Show a => LogMessage a -> String
showsPrec :: Int -> LogMessage a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LogMessage a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LogMessage a) x -> LogMessage a
forall a x. LogMessage a -> Rep (LogMessage a) x
$cto :: forall a x. Rep (LogMessage a) x -> LogMessage a
$cfrom :: forall a x. LogMessage a -> Rep (LogMessage a) x
Generic, forall a.
HasEnumerableConstructors a =>
Proxy (LogMessage a) -> [String]
forall a. HasEnumerableConstructors a => LogMessage a -> [String]
forall a.
(a -> [String])
-> (Proxy a -> [String]) -> HasEnumerableConstructors a
allConstructors :: Proxy (LogMessage a) -> [String]
$callConstructors :: forall a.
HasEnumerableConstructors a =>
Proxy (LogMessage a) -> [String]
listConstructors :: LogMessage a -> [String]
$clistConstructors :: forall a. HasEnumerableConstructors a => LogMessage a -> [String]
HasEnumerableConstructors)

-- | Concatenates two log messages with a newline, keeping the log level of that has the higher severity
instance (Semigroup String) => Semigroup (LogMessage String) where
  LogMessage String
a <> :: LogMessage String -> LogMessage String -> LogMessage String
<> LogMessage String
b = case (LogMessage String
a, LogMessage String
b) of
    (Stdout LogLevel
logLevelA String
a', Stdout LogLevel
logLevelB String
b') -> forall a. LogLevel -> a -> LogMessage a
Stdout (forall a. Ord a => a -> a -> a
max LogLevel
logLevelA LogLevel
logLevelB) (String
a' forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
b')
    (Stdout LogLevel
logLevelA String
a', LogMessage String
Ignore) -> forall a. LogLevel -> a -> LogMessage a
Stdout LogLevel
logLevelA String
a'
    (LogMessage String
Ignore, Stdout LogLevel
logLevelB String
b') -> forall a. LogLevel -> a -> LogMessage a
Stdout LogLevel
logLevelB String
b'
    (LogMessage String
Ignore, LogMessage String
Ignore) -> forall a. LogMessage a
Ignore