git.iko.soy/typeable/katip
on master help sign in
Fixed #10 (use implicit-parameter callstacks)
commit824cd547cac03356bde311efc356e8933be12296 authorAlfredo Di Napoli <alfredo.dinapoli@gmail.com> dateSun 3 Apr 2016, 19:46 (11 years ago) parente7bf6e7
5 files changed+26−18
compare with master
unifiedsplit
katip-elasticsearch/test/Main.hs+5−5 katip/examples/example.hs+3−3 katip/examples/example_lens.hs+3−3 katip/src/Katip/Core.hs+8−3 katip/src/Katip/Monadic.hs+7−4
katip-elasticsearch/test/Main.hs+5−5
@@ -82,7 +82,7 @@ esTests :: TestTree
8282esTests = testGroup "elasticsearch scribe"
8383 [
8484 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"
8686 liftIO $ do
8787 void done
8888 logs <- getLogs
@@ -94,10 +94,10 @@ esTests = testGroup "elasticsearch scribe"
9494 let t1 = mkTime 2016 1 2 3 4 5
9595 fakeClock <- newTVarIO t1
9696 withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do
97− $(logT) (ExampleCtx True) mempty InfoS "today"
97+ logT (ExampleCtx True) mempty InfoS "today"
9898 let t2 = mkTime 2016 1 3 3 4 5
9999 liftIO (atomically (writeTVar fakeClock t2))
100− $(logT) (ExampleCtx True) mempty InfoS "tomorrow"
100+ logT (ExampleCtx True) mempty InfoS "tomorrow"
101101 liftIO $ do
102102 void done
103103 todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-1-2")
@@ -112,10 +112,10 @@ esTests = testGroup "elasticsearch scribe"
112112 let t1 = mkTime 2016 3 5 0 0 0 -- saturday, march 5th
113113 fakeClock <- newTVarIO t1
114114 withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do
115− $(logT) (ExampleCtx True) mempty InfoS "today"
115+ logT (ExampleCtx True) mempty InfoS "today"
116116 let t2 = mkTime 2016 3 6 0 0 0 -- sunday march 6th
117117 liftIO (atomically (writeTVar fakeClock t2))
118− $(logT) (ExampleCtx True) mempty InfoS "tomorrow"
118+ logT (ExampleCtx True) mempty InfoS "tomorrow"
119119 liftIO $ do
120120 void done
121121 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
3232 let le' = registerScribe "stdout" handleScribe le
3333 let s = MyState M.mempty mempty le'
3434 runStack s $ do
35− $(logTM) InfoS "Started"
35+ logTM InfoS "Started"
3636 -- this will add "confrabulation" to the current namespace, making
3737 -- logs made under this block have the namespace of
3838 -- "main.confrabulation". Further, ConfrabLogCTX's key/value
@@ -41,9 +41,9 @@ main = do
4141 -- code and they will be flattened out and combined in the log
4242 -- output.
4343 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"
4545 confrabulateWidgets
46− $(logTM) InfoS "Namespace and context are back to normal"
46+ logTM InfoS "Namespace and context are back to normal"
4747
4848
4949-------------------------------------------------------------------------------
katip/examples/example_lens.hs+3−3
@@ -48,7 +48,7 @@ main = do
4848 let le' = registerScribe "stdout" handleScribe le
4949 let s = MyState M.mempty mempty le'
5050 runStack s $ do
51− $(logTM) InfoS "Started"
51+ logTM InfoS "Started"
5252 -- this will add "confrabulation" to the current namespace, making
5353 -- logs made under this block have the namespace of
5454 -- "main.confrabulation". Further, ConfrabLogCTX's key/value
@@ -57,9 +57,9 @@ main = do
5757 -- code and they will be flattened out and combined in the log
5858 -- output.
5959 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"
6161 confrabulateWidgets
62− $(logTM) InfoS "Namespace and context are back to normal"
62+ logTM InfoS "Namespace and context are back to normal"
6363
6464
6565-------------------------------------------------------------------------------
katip/src/Katip/Core.hs+8−3
@@ -741,9 +741,14 @@ getLoc = case getCallStack ?loc of
741741-------------------------------------------------------------------------------
742742-- | 'Loc'-tagged logging when using template-haskell.
743743--
744−-- @$(logT) obj mempty InfoS "Hello world"@
745−logT :: ExpQ
746−logT = [| \ a ns sev msg -> logItem a ns getLoc sev msg |]
744+-- @logT obj mempty InfoS "Hello world"@
745+logT :: (A.Applicative m, LogItem a, Katip m)
746+ => a
747+ -> Namespace
748+ -> Severity
749+ -> LogStr
750+ -> m ()
751+logT a ns = logItem a ns getLoc
747752
748753
749754-- taken from the file-location package
katip/src/Katip/Monadic.hs+7−4
@@ -185,9 +185,12 @@ logFM sev msg = do
185185-- | 'Loc'-tagged logging when using template-haskell. Automatically
186186-- supplies payload and namespace.
187187--
188−-- @$(logTM) InfoS "Hello world"@
189−logTM :: ExpQ
190−logTM = [| logItemM getLoc |]
188+-- @logTM InfoS "Hello world"@
189+logTM :: (Applicative m, KatipContext m, Katip m)
190+ => Severity
191+ -> LogStr
192+ -> m ()
193+logTM = logItemM getLoc
191194
192195
193196-------------------------------------------------------------------------------
@@ -219,7 +222,7 @@ logExceptionM action sev = action `catchAll` \e -> f e >> throwM e
219222-- ctx <- getKatipContext
220223-- ns <- getKatipNamespace
221224-- 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!"
223226-- doOtherStuff
224227-- @
225228newtype KatipContextT m a = KatipContextT {