@@ -5,6 +5,7 @@
55{-# LANGUAGE RecordWildCards #-}
66{-# LANGUAGE ScopedTypeVariables #-}
77{-# LANGUAGE StandaloneDeriving #-}
8+{-# LANGUAGE TemplateHaskell #-}
89{-# OPTIONS_GHC -fno-warn-orphans #-}
910module Katip.Tests
1011 ( tests
@@ -49,6 +50,7 @@ tests = testGroup "Katip"
4950 , logContextsTests
5051 , closeScribeTests
5152 , closeScribesTests
53+ , loggingTests
5254 ]
5355
5456
@@ -97,6 +99,45 @@ closeScribeTests = testGroup "closeScribe"
9799 ]
98100
99101
102+-------------------------------------------------------------------------------
103+loggingTests :: TestTree
104+loggingTests = testGroup "logging"
105+ [ testCase "logs in order with contexts, namespaces, etc" $ do
106+ (le, items) <- recordingEnv
107+ runKatipContextT le (sl "base_context" (42 :: Int)) "base_namespace" $ do
108+ $(logTM) InfoS "basic log"
109+ katipNoLogging $ do
110+ $(logTM) InfoS "you cant see this"
111+ katipAddNamespace "added" $ do
112+ katipAddNamespace "namespace" $ do
113+ $(logTM) InfoS "with namespaces"
114+ katipAddContext (sl "additional" True) $ do
115+ $(logTM) InfoS "additional context"
116+ _ <- closeScribes le
117+ summary <- fmap summarizeItem <$> readTVarIO items
118+ let baseCtx = HM.singleton "base_context" (Number 42)
119+ let baseNS = "tests" <> "base_namespace"
120+ summary @?=
121+ [ (baseNS, baseCtx, "basic log")
122+ , (baseNS <> "added" <> "namespace", baseCtx, "with namespaces")
123+ , (baseNS <> "added", HM.insert "additional" (Bool True) baseCtx, "additional context")
124+ ]
125+ ]
126+ where
127+ recordingEnv :: IO (LogEnv, TVar [Item Object])
128+ recordingEnv = do
129+ items <- newTVarIO mempty
130+ let scribe = Scribe
131+ { liPush = \i -> atomically (modifyTVar' items (<> [toObject <$> i]))
132+ , scribeFinalizer = return ()
133+ }
134+ le1 <- initLogEnv "tests" "test"
135+ le2 <- registerScribe "recorder" scribe defaultScribeSettings le1
136+ return (le2, items)
137+ summarizeItem :: Item Object -> (Namespace, Object, LogStr)
138+ summarizeItem Item {..} = (_itemNamespace, _itemPayload, _itemMessage)
139+
140+
100141-------------------------------------------------------------------------------
101142trivialScribe :: IO (Scribe, TVar Bool)
102143trivialScribe = do