-- 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, 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)

logLevelReader :: String -> Maybe LogLevel
logLevelReader :: String -> Maybe LogLevel
logLevelReader String
"trace" = forall a. a -> Maybe a
Just LogLevel
TRACE
logLevelReader String
"debug" = forall a. a -> Maybe a
Just LogLevel
DEBUG
logLevelReader String
"info"  = forall a. a -> Maybe a
Just LogLevel
INFO
logLevelReader String
"warn"  = forall a. a -> Maybe a
Just LogLevel
WARN
logLevelReader String
"error" = forall a. a -> Maybe a
Just LogLevel
ERROR
logLevelReader String
"none"  = forall a. a -> Maybe a
Just LogLevel
NONE
loglevelReader :: p -> Maybe a
loglevelReader p
_       = 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 -> forall msg. ToLogStr msg => msg -> LogStr
toLogStr FormattedTime
time forall a. Semigroup a => a -> a -> a
<> LogStr
" [" forall a. Semigroup a => a -> a -> a
<> forall msg. ToLogStr msg => msg -> LogStr
toLogStr (forall a. Show a => a -> String
show LogLevel
level) forall a. Semigroup a => a -> a -> a
<> LogStr
"] " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ LogLevel -> LogStr -> IO ()
logger LogLevel
level LogStr
str forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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"
    forall a.
IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger IO FormattedTime
timeCache LogType
logType forall a b. (a -> b) -> a -> b
$ \TimedFastLogger
timedLogger ->
        let logger :: LogLevel -> LogStr -> IO ()
logger LogLevel
level LogStr
str
                | LogLevel
level forall a. Ord a => a -> a -> Bool
< LogLevel
logLevel = 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