@@ -11,19 +11,20 @@ module Pos.Util.Log.Scribes
11
11
, mkJsonFileScribe
12
12
) where
13
13
14
- import Universum hiding ( fromString )
14
+ import Universum
15
15
16
16
import Control.AutoUpdate (UpdateSettings (.. ), defaultUpdateSettings ,
17
17
mkAutoUpdate )
18
18
import Control.Concurrent.MVar (modifyMVar_ )
19
19
20
20
import Data.Aeson.Text (encodeToLazyText )
21
+ import qualified Data.Text as T
21
22
import Data.Text.Lazy.Builder
22
23
import qualified Data.Text.Lazy.IO as TIO
23
24
import Data.Time (diffUTCTime )
25
+ import Data.Time.Format (defaultTimeLocale , formatTime )
24
26
import Katip.Core
25
- import Katip.Format.Time (formatAsIso8601 )
26
- import Katip.Scribes.Handle (brackets , getKeys )
27
+ import Katip.Scribes.Handle (brackets )
27
28
28
29
import qualified Pos.Util.Log.Internal as Internal
29
30
import Pos.Util.Log.LoggerConfig (RotationParameters (.. ))
@@ -49,7 +50,7 @@ mkTextFileScribe :: RotationParameters -> Internal.FileDescription -> Bool -> Se
49
50
mkTextFileScribe rot fdesc colorize s v = do
50
51
mkFileScribe rot fdesc formatter colorize s v
51
52
where
52
- formatter :: LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int
53
+ formatter :: {- LogItem a =>-} Handle -> Bool -> Verbosity -> Item a -> IO Int
53
54
formatter hdl colorize' v' item = do
54
55
let tmsg = toLazyText $ formatItem colorize' v' item
55
56
TIO. hPutStrLn hdl tmsg
@@ -100,7 +101,7 @@ mkFileScribeH :: Handle -> Bool -> Severity -> Verbosity -> IO Scribe
100
101
mkFileScribeH h colorize s v = do
101
102
hSetBuffering h LineBuffering
102
103
locklocal <- newMVar ()
103
- let logger :: forall a . LogItem a => Item a -> IO ()
104
+ let logger :: forall a . {- LogItem a =>-} Item a -> IO ()
104
105
logger item = when (permitItem s item) $
105
106
bracket_ (takeMVar locklocal) (putMVar locklocal () ) $
106
107
TIO. hPutStrLn h $! toLazyText $ formatItem colorize v item
@@ -120,42 +121,43 @@ mkDevNullScribe lh s v = do
120
121
h <- openFile " /dev/null" WriteMode
121
122
let colorize = False
122
123
hSetBuffering h LineBuffering
123
- let logger :: forall a . LogItem a => Item a -> IO ()
124
+ let logger :: forall a . {- LogItem a =>-} Item a -> IO ()
124
125
logger item = when (permitItem s item) $
125
126
Internal. incrementLinesLogged lh
126
127
>> (TIO. hPutStrLn h $! toLazyText $ formatItem colorize v item)
127
128
pure $ Scribe logger (hClose h)
128
129
129
130
130
131
-- | format a @LogItem@ with subsecond precision (ISO 8601)
131
- formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder
132
- formatItem withColor verb Item {.. } =
133
- brackets nowStr <>
134
- brackets (mconcat $ map fromText $ intercalateNs _itemNamespace) <>
135
- brackets (fromText (renderSeverity' _itemSeverity)) <>
136
- brackets (fromString _itemHost) <>
137
- brackets (fromString (show _itemProcess)) <>
138
- brackets (fromText (getThreadIdText _itemThread)) <>
139
- mconcat ks <>
140
- maybe mempty (brackets . fromString . locationToString) _itemLoc <>
132
+ formatItem :: Bool -> Verbosity -> Item a -> Builder
133
+ formatItem withColor _verb Item {.. } =
134
+ fromText header <>
135
+ fromText " " <>
136
+ brackets (fromText timestamp) <>
141
137
fromText " " <>
142
138
unLogStr _itemMessage
143
139
where
144
- nowStr = fromText (formatAsIso8601 _itemTime)
145
- ks = map brackets $ getKeys verb _itemPayload
146
- renderSeverity' s = case s of
147
- EmergencyS -> red $ renderSeverity s
148
- AlertS -> red $ renderSeverity s
149
- CriticalS -> red $ renderSeverity s
150
- ErrorS -> red $ renderSeverity s
151
- NoticeS -> magenta $ renderSeverity s
152
- WarningS -> yellow $ renderSeverity s
153
- InfoS -> blue $ renderSeverity s
154
- _ -> renderSeverity s
140
+ header = colorBySeverity _itemSeverity $
141
+ " [" <> mconcat namedcontext <> " :" <> severity <> " :" <> threadid <> " ]"
142
+ namedcontext = intercalateNs _itemNamespace
143
+ severity = renderSeverity _itemSeverity
144
+ threadid = getThreadIdText _itemThread
145
+ timestamp = T. pack $ formatTime defaultTimeLocale tsformat _itemTime
146
+ tsformat :: String
147
+ tsformat = " %F %T%2Q %Z"
148
+ colorBySeverity s m = case s of
149
+ EmergencyS -> red m
150
+ AlertS -> red m
151
+ CriticalS -> red m
152
+ ErrorS -> red m
153
+ NoticeS -> magenta m
154
+ WarningS -> yellow m
155
+ InfoS -> blue m
156
+ _ -> m
155
157
red = colorize " 31"
156
158
yellow = colorize " 33"
157
159
magenta = colorize " 35"
158
160
blue = colorize " 34"
159
- colorize c s
160
- | withColor = " \ESC [" <> c <> " m" <> s <> " \ESC [0m"
161
- | otherwise = s
161
+ colorize c m
162
+ | withColor = " \ESC [" <> c <> " m" <> m <> " \ESC [0m"
163
+ | otherwise = m
0 commit comments