ghcup-hs/lib/GHCup/Utils/Logger.hs

module GHCup.Utils.Logger where


import           Control.Monad.Logger
import           System.Console.Pretty

import qualified Data.ByteString as B


data LoggerConfig = LoggerConfig {
    lcPrintDebug :: Bool
  , outter :: B.ByteString -> IO ()
}


myLoggerT :: LoggerConfig -> LoggingT m a -> m a
myLoggerT LoggerConfig{..} loggingt = runLoggingT loggingt mylogger
 where
  mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
  mylogger _ _ level str' = do
    let l = case level of
          LevelDebug   -> if lcPrintDebug then toLogStr (style Bold $ color Blue   "[ Debug ]") else mempty
          LevelInfo    -> toLogStr (style Bold $ color Green  "[ Info  ]")
          LevelWarn    -> toLogStr (style Bold $ color Yellow "[ Warn  ]")
          LevelError   -> toLogStr (style Bold $ color Red    "[ Error ]")
          LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
    let out = fromLogStr (l <>  toLogStr " " <> str' <> toLogStr "\n")
    outter out