phino-0.0.0.50: src/Logger.hs

{-# LANGUAGE RecordWildCards #-}

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

module Logger
  ( logDebug,
    logInfo,
    logWarning,
    logError,
    setLogConfig,
    LogLevel (DEBUG, INFO, WARNING, 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 | WARNING | ERROR | NONE
  deriving (Show, Ord, Eq, Bounded, Enum, Read)

data Logger = Logger {level :: LogLevel, lines :: Int}

logger :: IORef Logger
{-# NOINLINE logger #-}
logger = unsafePerformIO (newIORef (Logger INFO 25))

setLogConfig :: LogLevel -> Integer -> IO ()
setLogConfig lvl lines = writeIORef logger (Logger lvl (fromIntegral lines))

logMessage :: LogLevel -> String -> IO ()
logMessage lvl message = do
  Logger {..} <- readIORef logger
  when
    (lvl >= level && lines /= 0)
    ( let lines' = DL.lines message
          toPrint = take lines lines'
          msg
            | lines == -1 = [message]
            | length lines' > lines = toPrint ++ ["---| log is limited by --log-lines=" ++ show lines ++ " option |---"]
            | otherwise = toPrint
       in hPutStrLn stderr ("[" ++ show lvl ++ "]: " ++ DL.intercalate "\n" msg)
    )

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