{-# LANGUAGE CPP #-}
module System.Log.Formatter( LogFormatter
, nullFormatter
, simpleLogFormatter
, tfLogFormatter
, varFormatter
) where
import Data.List
import Control.Applicative ((<$>))
import Control.Concurrent (myThreadId)
#ifndef mingw32_HOST_OS
import System.Posix.Process (getProcessID)
#endif
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import Data.Time (getZonedTime,getCurrentTime,formatTime)
import System.Log
type LogFormatter a = a
-> LogRecord
-> String
-> IO String
nullFormatter :: LogFormatter a
nullFormatter :: forall a. LogFormatter a
nullFormatter a
_ (Priority
_,String
msg) String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return String
msg
simpleLogFormatter :: String -> LogFormatter a
simpleLogFormatter :: forall a. String -> LogFormatter a
simpleLogFormatter String
format a
h (Priority
prio, String
msg) String
loggername =
forall a. String -> String -> LogFormatter a
tfLogFormatter String
"%F %X %Z" String
format a
h (Priority
prio,String
msg) String
loggername
tfLogFormatter :: String -> String -> LogFormatter a
tfLogFormatter :: forall a. String -> String -> LogFormatter a
tfLogFormatter String
timeFormat String
format = do
forall a. [(String, IO String)] -> String -> LogFormatter a
varFormatter [(String
"time", forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
timeFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime)
,(String
"utcTime", forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
timeFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime)
]
String
format
varFormatter :: [(String, IO String)] -> String -> LogFormatter a
varFormatter :: forall a. [(String, IO String)] -> String -> LogFormatter a
varFormatter [(String, IO String)]
vars String
format a
_h (Priority
prio,String
msg) String
loggername = do
String
outmsg <- [(String, IO String)] -> String -> IO String
replaceVarM ([(String, IO String)]
varsforall a. [a] -> [a] -> [a]
++[(String
"msg", forall (m :: * -> *) a. Monad m => a -> m a
return String
msg)
,(String
"prio", forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Priority
prio)
,(String
"loggername", forall (m :: * -> *) a. Monad m => a -> m a
return String
loggername)
,(String
"tid", forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ThreadId
myThreadId)
#ifndef mingw32_HOST_OS
,(String
"pid", forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
getProcessID)
#endif
]
)
String
format
forall (m :: * -> *) a. Monad m => a -> m a
return String
outmsg
replaceVarM :: [(String, IO String)]
-> String
-> IO String
replaceVarM :: [(String, IO String)] -> String -> IO String
replaceVarM [(String, IO String)]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
replaceVarM [(String, IO String)]
keyVals (Char
s:String
ss) | Char
sforall a. Eq a => a -> a -> Bool
==Char
'$' = do (String
f,String
rest) <- forall {m :: * -> *} {a}.
(Monad m, Eq a) =>
[([a], m String)] -> [a] -> m (String, [a])
replaceStart [(String, IO String)]
keyVals String
ss
String
repRest <- [(String, IO String)] -> String -> IO String
replaceVarM [(String, IO String)]
keyVals String
rest
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
f forall a. [a] -> [a] -> [a]
++ String
repRest
| Bool
otherwise = [(String, IO String)] -> String -> IO String
replaceVarM [(String, IO String)]
keyVals String
ss forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
sforall a. a -> [a] -> [a]
:)
where
replaceStart :: [([a], m String)] -> [a] -> m (String, [a])
replaceStart [] [a]
str = forall (m :: * -> *) a. Monad m => a -> m a
return (String
"$",[a]
str)
replaceStart (([a]
k,m String
v):[([a], m String)]
kvs) [a]
str | [a]
k forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
str = do String
vs <- m String
v
forall (m :: * -> *) a. Monad m => a -> m a
return (String
vs, forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
k) [a]
str)
| Bool
otherwise = [([a], m String)] -> [a] -> m (String, [a])
replaceStart [([a], m String)]
kvs [a]
str