@@ -1,17 +1,18 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE StandaloneDeriving #-}
4+{-# OPTIONS_GHC -fno-warn-orphans #-}
25module Main
36 ( main
47 ) where
58
69
710-------------------------------------------------------------------------------
8−import Blaze.ByteString.Builder
911import Control.Concurrent
10−import Control.Monad.IO.Class
11−import CriterionPlus
12+import Control.DeepSeq
13+import Criterion.Main
1214import Data.Aeson
1315import Data.Monoid
14−import Data.Text (Text)
1516import Data.Time.Calendar
1617import Data.Time.Clock
1718import System.IO
@@ -22,35 +23,39 @@ import Katip.Scribes.Handle
2223-------------------------------------------------------------------------------
2324
2425main :: IO ()
25−main = benchmark $
26− handleScribeBench
26+main = defaultMain [
27+ handleScribeBench
28+ ]
2729
2830
2931-------------------------------------------------------------------------------
30−handleScribeBench :: Benchmark ()
31−handleScribeBench = standoff "Katip.Scribes.Handle" $
32− subject "Bytestring Builder" $ do
33− pause
34− (Scribe push) <- liftIO setup
35− tid <- liftIO myThreadId
36− continue
37− whnfIO $ push $ exItem tid
32+handleScribeBench :: Benchmark
33+handleScribeBench = bgroup "Katip.Scribes.Handle" [
34+ env setupEnv $ \ ~(Scribe push, tid) ->
35+ bench "Bytestring Builder" $
36+ whnfIO $ push $ exItem tid
37+ ]
38+ where
39+ setupEnv = do
40+ scribe <- setup
41+ tid <- myThreadId
42+ return (scribe, mkThreadIdText tid)
3843
3944
4045-------------------------------------------------------------------------------
41−exItem :: ThreadId -> Item ExPayload
46+exItem :: ThreadIdText -> Item ExPayload
4247exItem tid = Item {
43− itemApp = Namespace ["app"]
44− , itemEnv = Environment "production"
45− , itemSeverity = Warning
46− , itemThread = tid
47− , itemHost = "example"
48− , itemProcess = CPid 123
49− , itemPayload = ExPayload
50− , itemMessage = "message"
51− , itemTime = mkUTCTime 2015 3 14 1 5 9
52− , itemNamespace = Namespace ["foo"]
53− , itemLoc = Nothing
48+ _itemApp = Namespace ["app"]
49+ , _itemEnv = Environment "production"
50+ , _itemSeverity = WarningS
51+ , _itemThread = tid
52+ , _itemHost = "example"
53+ , _itemProcess = CPid 123
54+ , _itemPayload = ExPayload
55+ , _itemMessage = "message"
56+ , _itemTime = mkUTCTime 2015 3 14 1 5 9
57+ , _itemNamespace = Namespace ["foo"]
58+ , _itemLoc = Nothing
5459 }
5560
5661
@@ -60,6 +65,8 @@ data ExPayload = ExPayload
6065instance ToJSON ExPayload where
6166 toJSON _ = Object mempty
6267
68+instance ToObject ExPayload
69+
6370instance LogItem ExPayload where
6471 payloadKeys _ _ = AllKeys
6572
@@ -76,4 +83,12 @@ mkUTCTime y mt d h mn s = UTCTime day dt
7683setup :: IO Scribe
7784setup = do
7885 h <- openFile "/dev/null" WriteMode
79− mkHandleScribe h Debug V0
86+ mkHandleScribe ColorIfTerminal h DebugS V0
87+
88+
89+-------------------------------------------------------------------------------
90+deriving instance NFData ThreadIdText
91+
92+
93+instance NFData Scribe where
94+ rnf (Scribe _) = ()