git.iko.soy/typeable/katip
on master help sign in
Use simple mvar locking on file handle

I realize this could possibly be better with a queue and a persistent thread but after some initial benchmarking, I'm happy with the minimal overhead here. If people end up using this for extremely high concurrency purposes and have better solutions to propose (a-la fastlogger), I'll be happy to take a PR. This solves #34

commit1f556c60a212f4549626183e2dc479cb96aa1718 authorMichael Xavier <michael@michaelxavier.net> dateFri 5 Aug 2016, 15:44 (10 years ago) parent021f8f2
3 files changed+14−7
compare with master
unifiedsplit
katip/bench/Main.hs+7−4 katip/katip.cabal+2−1 katip/src/Katip/Scribes/Handle.hs+5−2
katip/bench/Main.hs+7−4
@@ -12,7 +12,7 @@ import Control.Concurrent
1212import Control.DeepSeq
1313import Criterion.Main
1414import Data.Aeson
15−import Data.Monoid as M
15+import Data.Monoid as M
1616import Data.Time.Calendar
1717import Data.Time.Clock
1818import System.IO
@@ -31,12 +31,15 @@ main = defaultMain [
3131-------------------------------------------------------------------------------
3232handleScribeBench :: Benchmark
3333handleScribeBench = bgroup "Katip.Scribes.Handle" [
34− env setupEnv $ \ ~(Scribe push, tid) ->
34+ env setupHandleEnv $ \ ~(Scribe push, tid) ->
3535 bench "Bytestring Builder" $
3636 whnfIO $ push $ exItem tid
3737 ]
38− where
39− setupEnv = do
38+
39+
40+-------------------------------------------------------------------------------
41+setupHandleEnv :: IO (Scribe, ThreadIdText)
42+setupHandleEnv = do
4043 scribe <- setup
4144 tid <- myThreadId
4245 return (scribe, mkThreadIdText tid)
katip/katip.cabal+2−1
@@ -108,7 +108,7 @@ benchmark bench
108108 main-is: Main.hs
109109 hs-source-dirs: bench
110110 default-language: Haskell2010
111− ghc-options: -O2 -Wall
111+ ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N
112112 if flag(lib-Werror)
113113 ghc-options: -Werror
114114 build-depends:
@@ -122,3 +122,4 @@ benchmark bench
122122 , time
123123 , transformers
124124 , deepseq
125+ , async
katip/src/Katip/Scribes/Handle.hs+5−2
@@ -4,11 +4,13 @@ module Katip.Scribes.Handle where
44
55-------------------------------------------------------------------------------
66import Control.Applicative as A
7+import Control.Concurrent
8+import Control.Exception (bracket_)
79import Control.Monad
810import Data.Aeson
911import qualified Data.HashMap.Strict as HM
1012import Data.Monoid
11−import Data.Text (Text)
13+import Data.Text (Text)
1214import Data.Text.Lazy.Builder
1315import Data.Text.Lazy.IO as T
1416import Data.Time
@@ -62,8 +64,9 @@ mkHandleScribe cs h sev verb = do
6264 colorize <- case cs of
6365 ColorIfTerminal -> hIsTerminalDevice h
6466 ColorLog b -> return b
67+ lock <- newMVar ()
6568 return $ Scribe $ \ i@Item{..} -> do
66− when (permitItem sev i) $
69+ when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $
6770 T.hPutStrLn h $ toLazyText $ formatItem colorize verb i
6871
6972