{- |
   Module     : System.Log.Handler.Simple
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   License    : BSD3

   Portability: portable

Simple log handlers

Written by John Goerzen, jgoerzen\@complete.org
-}

module System.Log.Handler.Simple(streamHandler, fileHandler,
                                      GenericHandler (..),
                                      verboseStreamHandler)
    where

import Control.Exception (tryJust)
import Control.DeepSeq
import Data.Char (ord)

import System.Log
import System.Log.Handler
import System.Log.Formatter
import System.IO
import System.IO.Error
import Control.Concurrent.MVar

{- | A helper data type. -}

data GenericHandler a = GenericHandler {forall a. GenericHandler a -> Priority
priority :: Priority,
                                        forall a. GenericHandler a -> LogFormatter (GenericHandler a)
formatter :: LogFormatter (GenericHandler a),
                                        forall a. GenericHandler a -> a
privData :: a,
                                        forall a. GenericHandler a -> a -> String -> IO ()
writeFunc :: a -> String -> IO (),
                                        forall a. GenericHandler a -> a -> IO ()
closeFunc :: a -> IO () }

instance LogHandler (GenericHandler a) where
    setLevel :: GenericHandler a -> Priority -> GenericHandler a
setLevel GenericHandler a
sh Priority
p = GenericHandler a
sh{priority :: Priority
priority = Priority
p}
    getLevel :: GenericHandler a -> Priority
getLevel GenericHandler a
sh = forall a. GenericHandler a -> Priority
priority GenericHandler a
sh
    setFormatter :: GenericHandler a
-> LogFormatter (GenericHandler a) -> GenericHandler a
setFormatter GenericHandler a
sh LogFormatter (GenericHandler a)
f = GenericHandler a
sh{formatter :: LogFormatter (GenericHandler a)
formatter = LogFormatter (GenericHandler a)
f}
    getFormatter :: GenericHandler a -> LogFormatter (GenericHandler a)
getFormatter GenericHandler a
sh = forall a. GenericHandler a -> LogFormatter (GenericHandler a)
formatter GenericHandler a
sh
    emit :: GenericHandler a -> LogRecord -> String -> IO ()
emit GenericHandler a
sh (Priority
_,String
msg) String
_ = (forall a. GenericHandler a -> a -> String -> IO ()
writeFunc GenericHandler a
sh) (forall a. GenericHandler a -> a
privData GenericHandler a
sh) String
msg
    close :: GenericHandler a -> IO ()
close GenericHandler a
sh = (forall a. GenericHandler a -> a -> IO ()
closeFunc GenericHandler a
sh) (forall a. GenericHandler a -> a
privData GenericHandler a
sh)


{- | Create a stream log handler.  Log messages sent to this handler will
   be sent to the stream used initially.  Note that the 'close' method
   will have no effect on stream handlers; it does not actually close
   the underlying stream.  -}

streamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
streamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
h Priority
pri =
    do MVar ()
lock <- forall a. a -> IO (MVar a)
newMVar ()
       let mywritefunc :: Handle -> String -> IO ()
mywritefunc Handle
hdl String
msg =
               String
msg forall a b. NFData a => a -> b -> b
`deepseq`
               forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock (\()
_ -> do Handle -> String -> IO ()
writeToHandle Handle
hdl String
msg
                                       Handle -> IO ()
hFlush Handle
hdl
                             )
       forall (m :: * -> *) a. Monad m => a -> m a
return (GenericHandler {priority :: Priority
priority = Priority
pri,
                               formatter :: LogFormatter (GenericHandler Handle)
formatter = forall a. LogFormatter a
nullFormatter,
                               privData :: Handle
privData = Handle
h,
                               writeFunc :: Handle -> String -> IO ()
writeFunc = Handle -> String -> IO ()
mywritefunc,
                               closeFunc :: Handle -> IO ()
closeFunc = \Handle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()})
    where
      writeToHandle :: Handle -> String -> IO ()
writeToHandle Handle
hdl String
msg = do
          Either IOError ()
rv <- forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust IOError -> Maybe IOError
myException (Handle -> String -> IO ()
hPutStrLn Handle
hdl String
msg)
          forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {p}. Show p => Handle -> String -> p -> IO ()
handleWriteException Handle
hdl String
msg) forall (m :: * -> *) a. Monad m => a -> m a
return Either IOError ()
rv
      myException :: IOError -> Maybe IOError
myException IOError
e
          | IOError -> Bool
isDoesNotExistError IOError
e = forall a. a -> Maybe a
Just IOError
e
          | Bool
otherwise = forall a. Maybe a
Nothing
      handleWriteException :: Handle -> String -> p -> IO ()
handleWriteException Handle
hdl String
msg p
e =
          let msg' :: String
msg' = String
"Error writing log message: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show p
e forall a. [a] -> [a] -> [a]
++
                     String
" (original message: " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
")"
          in Handle -> String -> IO ()
hPutStrLn Handle
hdl (String -> String
encodingSave String
msg')
      encodingSave :: String -> String
encodingSave = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
c -> if Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
> Int
127
                                         then String
"\\" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Char -> Int
ord Char
c)
                                         else [Char
c])

{- | Create a file log handler.  Log messages sent to this handler
   will be sent to the filename specified, which will be opened
   in Append mode.  Calling 'close' on the handler will close the file.
   -}

fileHandler :: FilePath -> Priority -> IO (GenericHandler Handle)
fileHandler :: String -> Priority -> IO (GenericHandler Handle)
fileHandler String
fp Priority
pri = do
                     Handle
h <- String -> IOMode -> IO Handle
openFile String
fp IOMode
AppendMode
                     GenericHandler Handle
sh <- Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
h Priority
pri
                     forall (m :: * -> *) a. Monad m => a -> m a
return (GenericHandler Handle
sh{closeFunc :: Handle -> IO ()
closeFunc = Handle -> IO ()
hClose})

{- | Like 'streamHandler', but note the priority and logger name along
with each message. -}
verboseStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
verboseStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
verboseStreamHandler Handle
h Priority
pri = let fmt :: LogFormatter a
fmt = forall a. String -> LogFormatter a
simpleLogFormatter String
"[$loggername/$prio] $msg"
                             in do GenericHandler Handle
hndlr <- Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
h Priority
pri
                                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. LogHandler a => a -> LogFormatter a -> a
setFormatter GenericHandler Handle
hndlr forall a. LogFormatter a
fmt