{- |
Module      :  Neovim.Log
Description :  Logging utilities and reexports
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Log (
    disableLogger,
    withLogger,
    module System.Log.Logger,
) where

import Control.Exception
import System.Log.Formatter (simpleLogFormatter)
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import System.Log.Logger

-- | Disable logging to stderr.
disableLogger :: IO a -> IO a
disableLogger :: forall a. IO a -> IO a
disableLogger IO a
action = do
    String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
rootLoggerName Logger -> Logger
removeHandler
    IO a
action

{- | Initialize the root logger to avoid stderr and set it to log the given
 file instead. Simply wrap the main entry point with this function to
 initialze the logger.

 @
 main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do
     'putStrLn' "Hello, World!"
 @
-}
withLogger :: FilePath -> Priority -> IO a -> IO a
withLogger :: forall a. String -> Priority -> IO a -> IO a
withLogger String
fp Priority
p IO a
action =
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        IO (GenericHandler Handle)
setupRootLogger
        (\GenericHandler Handle
fh -> forall a. GenericHandler a -> a -> IO ()
closeFunc GenericHandler Handle
fh (forall a. GenericHandler a -> a
privData GenericHandler Handle
fh))
        (forall a b. a -> b -> a
const IO a
action)
  where
    setupRootLogger :: IO (GenericHandler Handle)
setupRootLogger = do
        -- We shouldn't log to stderr or stdout as it is not unlikely that our
        -- messagepack communication is handled via those channels.
        forall a. IO a -> IO a
disableLogger (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        -- Log to the given file instead
        GenericHandler Handle
fh <- String -> Priority -> IO (GenericHandler Handle)
fileHandler String
fp Priority
p
        -- Adjust logging format
        let fh' :: GenericHandler Handle
fh' = forall a. LogHandler a => a -> LogFormatter a -> a
setFormatter GenericHandler Handle
fh (forall a. String -> LogFormatter a
simpleLogFormatter String
"[$loggername : $prio] $msg")
        -- Adjust the log level as well
        String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
rootLoggerName (Priority -> Logger -> Logger
setLevel Priority
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LogHandler a => a -> Logger -> Logger
addHandler GenericHandler Handle
fh')
        -- For good measure, log some debug information
        String -> Priority -> String -> IO ()
logM String
"Neovim.Debug" Priority
DEBUG forall a b. (a -> b) -> a -> b
$
            [String] -> String
unwords [String
"Initialized root looger with priority", forall a. Show a => a -> String
show Priority
p, String
"and file: ", String
fp]
        forall (m :: * -> *) a. Monad m => a -> m a
return GenericHandler Handle
fh'