6307556 · typeable/katip

git.iko.soy/typeable/katip

on master help sign in

Use Builder for log message, remove blaze-builder dep

6307556Ozgun Ataman12 years ago

katip/katip.cabal+1−1

compare with master

unifiedsplit

@@ -32,9 +32,9 @@ library

32 base >=4.6 && <4.7

33 , aeson >=0.7 && <0.8

34 , auto-update >= 0.1 && < 0.2

35− , blaze-builder >= 0.3 && < 0.4

36 , bytestring >= 0.9 && < 0.11

35 , bytestring >= 0.9 && < 0.11

37 , containers >=0.5 && <0.6

36 , containers >=0.5 && <0.6

37+ , exceptions >= 0.5 && < 0.7

38 , hostname >=1.0 && <1.1

39 , lens >=4.2 && <4.7

40 , lens-aeson >= 1.0 && < 1.1

katip/src/Katip.hs+5

@@ -8,6 +8,8 @@ module Katip

8 , PayloadSelection (..)

9 , Scribe (..)

10 , LogEnv (..)

11+ , KatipT (..)

12+ , runKatipT

12 -- * Initializing Loggers

14 -- * Initializing Loggers

13 , initLogEnv

15 , initLogEnv

@@ -15,6 +17,9 @@ module Katip

15 , unregisterScribe

17 , unregisterScribe

17 -- * Logging Functions

19 -- * Logging Functions

20+ , LogStr (..)

21+ , logStr, ls

22+

18 , logF

23 , logF

19 , logM

24 , logM

20 , logT

25 , logT

katip/src/Katip/Core.hs+43−5

@@ -14,6 +14,7 @@ import Control.Applicative

14import Control.AutoUpdate

15import Control.Concurrent

16import Control.Lens

17+import Control.Monad.Catch

17import Control.Monad.Reader

18import Control.Monad.Reader

18import Data.Aeson (ToJSON (..))

19import Data.Aeson (ToJSON (..))

19import qualified Data.Aeson as A

20import qualified Data.Aeson as A

@@ -26,6 +27,7 @@ import Data.String

26import Data.String.Conv

27import Data.String.Conv

27import Data.Text (Text)

28import Data.Text (Text)

28import qualified Data.Text as T

29import qualified Data.Text as T

30+import qualified Data.Text.Lazy.Builder as B

29import Data.Time

31import Data.Time

30import GHC.Generics hiding (to)

32import GHC.Generics hiding (to)

31import Language.Haskell.TH

33import Language.Haskell.TH

@@ -98,6 +100,29 @@ instance ToJSON Severity where

98 toJSON s = A.String (renderSeverity s)

100 toJSON s = A.String (renderSeverity s)

101

100

102

103+-------------------------------------------------------------------------------

104+-- | Log message with Builder unerneath; use '<>' to concat in O(1).

105+newtype LogStr = LogStr { unLogStr :: B.Builder }

106+ deriving (Generic)

107+

108+instance IsString LogStr where

109+ fromString = LogStr . B.fromString

110+

111+

112+-------------------------------------------------------------------------------

113+-- | Pack any string-like thing into a 'LogMsg'. This will

114+-- automatically work on 'String', 'ByteString, 'Text' and any of the

115+-- lazy variants.

116+logStr :: StringConv a Text => a -> LogStr

117+logStr t = LogStr (B.fromText $ toS t)

118+

119+

120+-------------------------------------------------------------------------------

121+-- | Shorthand for 'logMsg'

122+ls :: StringConv a Text => a -> LogStr

123+ls = logStr

124+

125+

101-------------------------------------------------------------------------------

126-------------------------------------------------------------------------------

102-- | This has everything each log message will contain.

127-- | This has everything each log message will contain.

103data Item a = Item {

128data Item a = Item {

@@ -108,7 +133,7 @@ data Item a = Item {

108 , itemHost :: HostName

133 , itemHost :: HostName

109 , itemProcess :: ProcessID

134 , itemProcess :: ProcessID

110 , itemPayload :: a

135 , itemPayload :: a

111− , itemMessage :: Text

136+ , itemMessage :: LogStr

112 , itemTime :: UTCTime

137 , itemTime :: UTCTime

113 , itemNamespace :: Namespace

138 , itemNamespace :: Namespace

114 , itemLoc :: Maybe Loc

139 , itemLoc :: Maybe Loc

@@ -125,7 +150,7 @@ instance ToJSON a => ToJSON (Item a) where

125 , "host" A..= itemHost

150 , "host" A..= itemHost

126 , "pid" A..= A.String (toS (show itemProcess))

151 , "pid" A..= A.String (toS (show itemProcess))

127 , "data" A..= itemPayload

152 , "data" A..= itemPayload

128− , "msg" A..= itemMessage

153+ , "msg" A..= (B.toLazyText $ unLogStr itemMessage)

129 , "at" A..= itemTime

154 , "at" A..= itemTime

130 , "ns" A..= itemNamespace

155 , "ns" A..= itemNamespace

131 , "loc" A..= fmap LocJs itemLoc

156 , "loc" A..= fmap LocJs itemLoc

@@ -236,6 +261,19 @@ class Katip m where

236 getLogEnv :: m LogEnv

261 getLogEnv :: m LogEnv

237

262

238

263

264+-------------------------------------------------------------------------------

265+-- | A concrete monad you can use to run logging actions.

266+newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }

267+ deriving ( Monad, MonadIO, MonadMask, MonadCatch, MonadThrow

268+ , MonadReader LogEnv)

269+

270+

271+-------------------------------------------------------------------------------

272+-- | Execute 'KatipT' on a log env.

273+runKatipT :: LogEnv -> KatipT m a -> m a

274+runKatipT le (KatipT f) = runReaderT f le

275+

276+

239-------------------------------------------------------------------------------

277-------------------------------------------------------------------------------

240-- | Log with everything, including a source code location. This is

278-- | Log with everything, including a source code location. This is

241-- very low level and you typically can use 'logT' in its place.

279-- very low level and you typically can use 'logT' in its place.

@@ -245,7 +283,7 @@ logI

245 -> Namespace

283 -> Namespace

246 -> Maybe Loc

284 -> Maybe Loc

247 -> Severity

285 -> Severity

248− -> Text

286+ -> LogStr

249 -> m ()

287 -> m ()

250logI a ns loc sev msg = do

288logI a ns loc sev msg = do

251 LogEnv{..} <- getLogEnv

289 LogEnv{..} <- getLogEnv

@@ -274,7 +312,7 @@ logF

274 -- ^ Specific namespace of the message.

312 -- ^ Specific namespace of the message.

275 -> Severity

313 -> Severity

276 -- ^ Severity of the message

314 -- ^ Severity of the message

277− -> Text

315+ -> LogStr

278 -- ^ The log message

316 -- ^ The log message

279 -> m ()

317 -> m ()

280logF a ns sev msg = logI a ns Nothing sev msg

318logF a ns sev msg = logI a ns Nothing sev msg

@@ -286,7 +324,7 @@ logM

286 :: (Applicative m, MonadIO m, Katip m)

324 :: (Applicative m, MonadIO m, Katip m)

287 => Namespace

325 => Namespace

288 -> Severity

326 -> Severity

289− -> Text

327+ -> LogStr

290 -> m ()

328 -> m ()

291logM ns sev msg = logF () ns sev msg

329logM ns sev msg = logF () ns sev msg

292

330

katip/src/Katip/Scribes/Handle.hs+8−9

@@ -6,17 +6,16 @@ module Katip.Scribes.Handle

6 ) where

8-------------------------------------------------------------------------------

9−import Blaze.ByteString.Builder

10−import Blaze.ByteString.Builder.Char.Utf8

11import Control.Lens

9import Control.Lens

12import Control.Monad

10import Control.Monad

13import Data.Aeson.Lens

11import Data.Aeson.Lens

14−import qualified Data.ByteString.Char8 as B

12+import qualified Data.HashMap.Strict as HM

15−import qualified Data.HashMap.Strict as HM

16import Data.Monoid

13import Data.Monoid

14+import Data.Text.Lazy.Builder

15+import Data.Text.Lazy.IO as T

17import Data.Time

16import Data.Time

18import System.IO

17import System.IO

19−import System.IO.Unsafe (unsafePerformIO)

18+import System.IO.Unsafe (unsafePerformIO)

20import System.Locale

19import System.Locale

21-------------------------------------------------------------------------------

20-------------------------------------------------------------------------------

22import Katip.Core

21import Katip.Core

@@ -25,7 +24,7 @@ import Katip.Core

26-------------------------------------------------------------------------------

25-------------------------------------------------------------------------------

27brackets :: Builder -> Builder

26brackets :: Builder -> Builder

28−brackets m = fromByteString "[" <> m <> fromByteString "]"

27+brackets m = fromText "[" <> m <> fromText "]"

31-------------------------------------------------------------------------------

30-------------------------------------------------------------------------------

@@ -41,7 +40,7 @@ renderPrim :: Primitive -> Builder

41renderPrim (StringPrim t) = fromText t

40renderPrim (StringPrim t) = fromText t

42renderPrim (NumberPrim s) = fromString (show s)

41renderPrim (NumberPrim s) = fromString (show s)

43renderPrim (BoolPrim b) = fromString (show b)

42renderPrim (BoolPrim b) = fromString (show b)

44−renderPrim NullPrim = fromByteString "null"

43+renderPrim NullPrim = fromText "null"

47-------------------------------------------------------------------------------

46-------------------------------------------------------------------------------

@@ -61,7 +60,7 @@ mkHandleScribe cs h sev verb = do

61 ColorLog b -> return b

60 ColorLog b -> return b

62 return $ Scribe $ \ i@Item{..} -> do

61 return $ Scribe $ \ i@Item{..} -> do

63 when (itemSeverity >= sev) $

62 when (itemSeverity >= sev) $

64− B.hPutStrLn h $ toByteString $ formatItem colorize verb i

63+ T.hPutStrLn h $ toLazyText $ formatItem colorize verb i

67-------------------------------------------------------------------------------

66-------------------------------------------------------------------------------

@@ -75,7 +74,7 @@ formatItem withColor verb Item{..} =

75 brackets (fromString (show itemThread)) <>

74 brackets (fromString (show itemThread)) <>

76 mconcat ks <>

75 mconcat ks <>

77 maybe mempty (brackets . fromString . locationToString) itemLoc <>

76 maybe mempty (brackets . fromString . locationToString) itemLoc <>

78− fromText " " <> fromText itemMessage

77+ fromText " " <> (unLogStr itemMessage)

79 where

78 where

80 nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime

79 nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime

81 ks = map brackets $ getKeys verb itemPayload

80 ks = map brackets $ getKeys verb itemPayload