-- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (C) 2023 Bin Jin. All Rights Reserved.

module Network.HProx.Log
  ( LogLevel(..)
  , LogStr
  , LogType'(..)
  , Logger
  , ToLogStr(..)
  , logLevelReader
  , pureLogger
  , withLogger
  ) where

import System.IO.Unsafe (unsafePerformIO)

import System.Log.FastLogger

-- | Logging level, default value is INFO
data LogLevel = TRACE
              | DEBUG
              | INFO
              | WARN
              | ERROR
              | NONE
    deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel =>
(LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord 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
$ccompare :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$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
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord)

logLevelReader :: String -> Maybe LogLevel
logLevelReader :: String -> Maybe LogLevel
logLevelReader String
"trace" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
TRACE
logLevelReader String
"debug" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
DEBUG
logLevelReader String
"info"  = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
INFO
logLevelReader String
"warn"  = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
WARN
logLevelReader String
"error" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
ERROR
logLevelReader String
"none"  = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
NONE
logLevelReader String
_       = Maybe LogLevel
forall a. Maybe a
Nothing

logWith :: TimedFastLogger -> LogLevel -> LogStr -> IO ()
logWith :: TimedFastLogger -> LogLevel -> LogStr -> IO ()
logWith TimedFastLogger
logger LogLevel
level LogStr
logstr = TimedFastLogger
logger (\FormattedTime
time -> FormattedTime -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr FormattedTime
time LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
" [" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (LogLevel -> String
forall a. Show a => a -> String
show LogLevel
level) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"] " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
logstr LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n")

type Logger = LogLevel -> LogStr -> IO ()

{-# NOINLINE pureLogger #-}
pureLogger :: Logger -> LogLevel -> LogStr -> a -> a
pureLogger :: forall a.
(LogLevel -> LogStr -> IO ()) -> LogLevel -> LogStr -> a -> a
pureLogger LogLevel -> LogStr -> IO ()
logger LogLevel
level LogStr
str a
a = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ LogLevel -> LogStr -> IO ()
logger LogLevel
level LogStr
str IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

withLogger :: LogType -> LogLevel -> ((LogLevel -> LogStr -> IO ()) -> IO ()) -> IO ()
withLogger :: LogType
-> LogLevel -> ((LogLevel -> LogStr -> IO ()) -> IO ()) -> IO ()
withLogger LogType
logType LogLevel
logLevel (LogLevel -> LogStr -> IO ()) -> IO ()
toRun = do
    IO FormattedTime
timeCache <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
"%Y/%m/%d %T %Z"
    IO FormattedTime -> LogType -> (TimedFastLogger -> IO ()) -> IO ()
forall a.
IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger IO FormattedTime
timeCache LogType
logType ((TimedFastLogger -> IO ()) -> IO ())
-> (TimedFastLogger -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TimedFastLogger
timedLogger ->
        let logger :: LogLevel -> LogStr -> IO ()
logger LogLevel
level LogStr
str
                | LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
< LogLevel
logLevel = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise        = TimedFastLogger -> LogLevel -> LogStr -> IO ()
logWith TimedFastLogger
timedLogger LogLevel
level LogStr
str
        in (LogLevel -> LogStr -> IO ()) -> IO ()
toRun LogLevel -> LogStr -> IO ()
logger