module Control.Monad.Log.Syslog where

import Control.Monad.IO.Class
import Control.Monad.Log
import Data.ByteString.Char8 as C8
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import System.IO
import Data.String
import qualified System.Posix.Syslog as Posix

-- | Log messages to a posix system log. The string argument is a tag that can
-- be used to identify log messages produced by this logger.
-- You can, for instance, run @journalctl --user -t mytag@ to see log messages
-- tagged with @"mytag"@.
logToSyslog :: (MonadIO m) => String -> Handler m (WithSeverity ByteString)
logToSyslog :: String -> Handler m (WithSeverity ByteString)
logToSyslog String
tagstr = \(WithSeverity Severity
sev ByteString
msg) ->
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> [Option] -> Facility -> IO () -> IO ()
forall a. String -> [Option] -> Facility -> IO a -> IO a
Posix.withSyslog String
tagstr [Option
Posix.DelayedOpen] Facility
Posix.User (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
msg ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      Maybe Facility -> Priority -> CStringLen -> IO ()
Posix.syslog Maybe Facility
forall a. Maybe a
Nothing (Severity -> Priority
syslogPriority Severity
sev)

syslogPriority :: Severity -> Posix.Priority
syslogPriority :: Severity -> Priority
syslogPriority = \case
  Severity
Emergency -> Priority
Posix.Emergency  
  Severity
Alert -> Priority
Posix.Alert  
  Severity
Critical -> Priority
Posix.Critical  
  Severity
Error -> Priority
Posix.Error  
  Severity
Warning -> Priority
Posix.Warning  
  Severity
Notice -> Priority
Posix.Notice  
  Severity
Informational -> Priority
Posix.Info 
  Severity
Debug-> Priority
Posix.Debug