{-# LANGUAGE RecordWildCards #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Logger
  ( logDebug
  , logInfo
  , logError
  , logging
  , setLogConfig
  , LogLevel (DEBUG, INFO, ERROR, NONE)
  )
where

import Control.Monad (when)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.List as DL
import GHC.IO (unsafePerformIO)
import System.IO

data LogLevel = DEBUG | INFO | 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, 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, 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, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
$cminBound :: LogLevel
minBound :: LogLevel
$cmaxBound :: LogLevel
maxBound :: LogLevel
Bounded, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
pred :: LogLevel -> LogLevel
$ctoEnum :: Int -> LogLevel
toEnum :: Int -> LogLevel
$cfromEnum :: LogLevel -> Int
fromEnum :: LogLevel -> Int
$cenumFrom :: LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
Enum, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LogLevel
readsPrec :: Int -> ReadS LogLevel
$creadList :: ReadS [LogLevel]
readList :: ReadS [LogLevel]
$creadPrec :: ReadPrec LogLevel
readPrec :: ReadPrec LogLevel
$creadListPrec :: ReadPrec [LogLevel]
readListPrec :: ReadPrec [LogLevel]
Read)

data Logger = Logger {Logger -> LogLevel
level :: LogLevel, Logger -> Int
lns :: Int}

logger :: IORef Logger
{-# NOINLINE logger #-}
logger :: IORef Logger
logger = IO (IORef Logger) -> IORef Logger
forall a. IO a -> a
unsafePerformIO (Logger -> IO (IORef Logger)
forall a. a -> IO (IORef a)
newIORef (LogLevel -> Int -> Logger
Logger LogLevel
ERROR Int
25))

setLogConfig :: LogLevel -> Int -> IO ()
setLogConfig :: LogLevel -> Int -> IO ()
setLogConfig LogLevel
lvl Int
cnt = IORef Logger -> Logger -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Logger
logger (LogLevel -> Int -> Logger
Logger LogLevel
lvl Int
cnt)

logging :: LogLevel -> IO Bool
logging :: LogLevel -> IO Bool
logging LogLevel
lvl = do
  Logger{Int
LogLevel
level :: Logger -> LogLevel
lns :: Logger -> Int
level :: LogLevel
lns :: Int
..} <- IORef Logger -> IO Logger
forall a. IORef a -> IO a
readIORef IORef Logger
logger
  Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
level Bool -> Bool -> Bool
&& Int
lns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)

logMessage :: LogLevel -> String -> IO ()
logMessage :: LogLevel -> String -> IO ()
logMessage LogLevel
lvl String
message = do
  Logger{Int
LogLevel
level :: Logger -> LogLevel
lns :: Logger -> Int
level :: LogLevel
lns :: Int
..} <- IORef Logger -> IO Logger
forall a. IORef a -> IO a
readIORef IORef Logger
logger
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
level Bool -> Bool -> Bool
&& Int
lns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
    ( let split :: [String]
split = String -> [String]
DL.lines String
message
          toPrint :: [String]
toPrint = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
lns [String]
split
          msg :: [String]
msg
            | Int
lns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = [String
message]
            | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
split Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lns = [String]
toPrint [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"---| log is limited by --log-lines=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lns String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" option |---"]
            | Bool
otherwise = [String]
toPrint
       in Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LogLevel -> String
forall a. Show a => a -> String
show LogLevel
lvl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
DL.intercalate String
"\n" [String]
msg)
    )

logDebug, logInfo, logError :: String -> IO ()
logDebug :: String -> IO ()
logDebug = LogLevel -> String -> IO ()
logMessage LogLevel
DEBUG
logInfo :: String -> IO ()
logInfo = LogLevel -> String -> IO ()
logMessage LogLevel
INFO
logError :: String -> IO ()
logError = LogLevel -> String -> IO ()
logMessage LogLevel
ERROR