824cd54 · typeable/katip

katip-elasticsearch/test/Main.hs+5−5

@@ -82,7 +82,7 @@ esTests :: TestTree

82esTests = testGroup "elasticsearch scribe"

83 [

84 withSearch' (\c -> c { essIndexSharding = NoIndexSharding}) $ \setup -> testCase "it flushes to elasticsearch" $ withTestLogging setup $ \done -> do

85− $(logT) (ExampleCtx True) mempty InfoS "A test message"

85+ logT (ExampleCtx True) mempty InfoS "A test message"

86 liftIO $ do

87 void done

88 logs <- getLogs

@@ -94,10 +94,10 @@ esTests = testGroup "elasticsearch scribe"

94 let t1 = mkTime 2016 1 2 3 4 5

95 fakeClock <- newTVarIO t1

96 withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do

97− $(logT) (ExampleCtx True) mempty InfoS "today"

97+ logT (ExampleCtx True) mempty InfoS "today"

98 let t2 = mkTime 2016 1 3 3 4 5

99 liftIO (atomically (writeTVar fakeClock t2))

100− $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

100+ logT (ExampleCtx True) mempty InfoS "tomorrow"

101 liftIO $ do

102 void done

103 todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-1-2")

@@ -112,10 +112,10 @@ esTests = testGroup "elasticsearch scribe"

112 let t1 = mkTime 2016 3 5 0 0 0 -- saturday, march 5th

113 fakeClock <- newTVarIO t1

114 withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do

115− $(logT) (ExampleCtx True) mempty InfoS "today"

115+ logT (ExampleCtx True) mempty InfoS "today"

116 let t2 = mkTime 2016 3 6 0 0 0 -- sunday march 6th

117 liftIO (atomically (writeTVar fakeClock t2))

118− $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

118+ logT (ExampleCtx True) mempty InfoS "tomorrow"

119 liftIO $ do

120 void done

121 todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-2-28") -- rounds back to previous sunday

katip/examples/example.hs+3−3

@@ -32,7 +32,7 @@ main = do

32 let le' = registerScribe "stdout" handleScribe le

33 let s = MyState M.mempty mempty le'

34 runStack s $ do

35− $(logTM) InfoS "Started"

35+ logTM InfoS "Started"

36 -- this will add "confrabulation" to the current namespace, making

37 -- logs made under this block have the namespace of

38 -- "main.confrabulation". Further, ConfrabLogCTX's key/value

@@ -41,9 +41,9 @@ main = do

41 -- code and they will be flattened out and combined in the log

42 -- output.

43 addNamespace "confrabulation" $ addContext (ConfrabLogCTX 42) $ do

44− $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"

44+ logTM DebugS "Confrabulating widgets, with extra namespace and context"

45 confrabulateWidgets

46− $(logTM) InfoS "Namespace and context are back to normal"

46+ logTM InfoS "Namespace and context are back to normal"

47

48

49-------------------------------------------------------------------------------

katip/examples/example_lens.hs+3−3

@@ -48,7 +48,7 @@ main = do

48 let le' = registerScribe "stdout" handleScribe le

49 let s = MyState M.mempty mempty le'

50 runStack s $ do

51− $(logTM) InfoS "Started"

51+ logTM InfoS "Started"

52 -- this will add "confrabulation" to the current namespace, making

53 -- logs made under this block have the namespace of

54 -- "main.confrabulation". Further, ConfrabLogCTX's key/value

@@ -57,9 +57,9 @@ main = do

57 -- code and they will be flattened out and combined in the log

58 -- output.

59 addNamespace "confrabulation" $ addContext (ConfrabLogCTX 42) $ do

60− $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"

60+ logTM DebugS "Confrabulating widgets, with extra namespace and context"

61 confrabulateWidgets

62− $(logTM) InfoS "Namespace and context are back to normal"

62+ logTM InfoS "Namespace and context are back to normal"

63

64

65-------------------------------------------------------------------------------

katip/src/Katip/Core.hs+8−3

@@ -741,9 +741,14 @@ getLoc = case getCallStack ?loc of

741-------------------------------------------------------------------------------

742-- | 'Loc'-tagged logging when using template-haskell.

743--

744−-- @$(logT) obj mempty InfoS "Hello world"@

744+-- @logT obj mempty InfoS "Hello world"@

745−logT :: ExpQ

745+logT :: (A.Applicative m, LogItem a, Katip m)

746+ => a

747+ -> Namespace

748+ -> Severity

749+ -> LogStr

750+ -> m ()

746−logT = [| \ a ns sev msg -> logItem a ns getLoc sev msg |]

751+logT a ns = logItem a ns getLoc

747

752

748

753

749-- taken from the file-location package

754-- taken from the file-location package

katip/src/Katip/Monadic.hs+7−4

@@ -185,9 +185,12 @@ logFM sev msg = do

185-- | 'Loc'-tagged logging when using template-haskell. Automatically

186-- supplies payload and namespace.

187--

188−-- @$(logTM) InfoS "Hello world"@

188+-- @logTM InfoS "Hello world"@

189−logTM :: ExpQ

189+logTM :: (Applicative m, KatipContext m, Katip m)

190+ => Severity

191+ -> LogStr

192+ -> m ()

190−logTM = [| logItemM getLoc |]

193+logTM = logItemM getLoc

191

194

192

195

193-------------------------------------------------------------------------------

196-------------------------------------------------------------------------------

@@ -219,7 +222,7 @@ logExceptionM action sev = action `catchAll` \e -> f e >> throwM e

219-- ctx <- getKatipContext

222-- ctx <- getKatipContext

220-- ns <- getKatipNamespace

223-- ns <- getKatipNamespace

221-- forkIO $ runKatipContextT le ctx ns $ do

224-- forkIO $ runKatipContextT le ctx ns $ do

222−-- $(logTM) InfoS "Look, I can log in IO and retain context!"

225+-- logTM InfoS "Look, I can log in IO and retain context!"

223-- doOtherStuff

226-- doOtherStuff

224-- @

227-- @

225newtype KatipContextT m a = KatipContextT {

228newtype KatipContextT m a = KatipContextT {