@@ -3,21 +3,21 @@
33module Katip.Scribes.Handle where
44
55-------------------------------------------------------------------------------
6−import Control.Applicative as A
7−import Control.Concurrent
8−import Control.Exception (bracket_)
6+import Control.Applicative as A
97import Control.Monad
108import Data.Aeson
11−import qualified Data.HashMap.Strict as HM
9+import qualified Data.HashMap.Strict as HM
1210import Data.Monoid
13−import Data.Text (Text)
11+import Data.Text (Text)
1412import Data.Text.Lazy.Builder
15−import Data.Text.Lazy.IO as T
13+import Data.Text.Lazy.IO as T
1614import System.IO
17−import System.IO.Unsafe (unsafePerformIO)
15+import System.IO.Unsafe (unsafePerformIO)
16+import qualified Control.Concurrent.Chan.Unagi.Bounded as U
17+import Control.Concurrent.Async
1818-------------------------------------------------------------------------------
1919import Katip.Core
20−import Katip.Format.Time (formatAsLogTime)
20+import Katip.Format.Time (formatAsLogTime)
2121-------------------------------------------------------------------------------
2222
2323
@@ -48,6 +48,10 @@ data ColorStrategy
4848 | ColorIfTerminal
4949 -- ^ Color if output is a terminal
5050
51+-------------------------------------------------------------------------------
52+data WorkerCmd =
53+ NewItem Builder
54+ | PoisonPill
5155
5256-------------------------------------------------------------------------------
5357-- | Logs to a file handle such as stdout, stderr, or a file. Contexts
@@ -59,15 +63,25 @@ data ColorStrategy
5963-- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal
6064mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
6165mkHandleScribe cs h sev verb = do
62− hSetBuffering h LineBuffering
63− colorize <- case cs of
64− ColorIfTerminal -> hIsTerminalDevice h
65− ColorLog b -> return b
66− lock <- newMVar ()
67− return $ Scribe $ \ i@Item{..} -> do
68− when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $
69− T.hPutStrLn h $ toLazyText $ formatItem colorize verb i
66+ (inChan, outChan) <- U.newChan 4096
67+ -- TODO: Come up with a good story for resource cleanup.
68+ _ <- async $ workerLoop outChan
69+ hSetBuffering h LineBuffering
70+ colorize <- case cs of
71+ ColorIfTerminal -> hIsTerminalDevice h
72+ ColorLog b -> return b
73+ return $ Scribe $ \i -> when (permitItem sev i) $ do
74+ void (U.tryWriteChan inChan (NewItem (formatItem colorize verb i)))
7075
76+ where
77+ workerLoop :: U.OutChan WorkerCmd -> IO ()
78+ workerLoop outChan = do
79+ newCmd <- U.readChan outChan
80+ case newCmd of
81+ NewItem b -> do
82+ T.hPutStrLn h $ toLazyText b
83+ workerLoop outChan
84+ PoisonPill -> return ()
7185
7286-------------------------------------------------------------------------------
7387formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder