Log.hs

module HSInstall.Log
  ( initLogging
  , d, n
  )
  where

import System.IO (stdout)
import System.Log.Color (colors16)
import System.Log.Color.Formatter (colorLogFormatter)
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple (streamHandler)
import System.Log.Logger

import HSInstall.Opts (DebugLog (..), Options (..), Verbose (..))


d, n :: String
d = "debug"
n = "normal"

msgFormat :: String
msgFormat = "hsinstall $padPrio: $msg"


initLogging :: Options -> IO ()
initLogging (Options _ (Verbose beVerbose) (DebugLog enableDebugLog)) = do
  -- Removes the root logger's default handler that writes every
  -- message to stderr!
  updateGlobalLogger rootLoggerName removeHandler

  setupLogger d msgFormat $ if enableDebugLog then Just DEBUG else Nothing
  setupLogger n msgFormat . Just $ if beVerbose then INFO else NOTICE


setupLogger :: String -> String -> Maybe Priority -> IO ()
setupLogger loggerName msgFormat' mLogPriority = do
  case mLogPriority of
    Nothing -> pure ()
    (Just logPriority) -> do
      updateGlobalLogger loggerName . addHandler
        . flip setFormatter (colorLogFormatter colors16 msgFormat')
          =<< streamHandler stdout DEBUG

      updateGlobalLogger loggerName $ setLevel logPriority