Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env stack
- {- stack --install-ghc
- --resolver lts-10.7
- script
- --compile
- --package katip
- --package universum
- --package aeson
- -}
- {-# LANGUAGE OverloadedStrings #-}
- {-# LANGUAGE OverloadedLists #-}
- {-# LANGUAGE NoImplicitPrelude #-}
- import Data.Aeson
- import Katip
- import Katip.Monadic
- import Universum
- main = do
- loggingBracket $ \logging ->
- runKatipContextT (ltsLogEnv logging) (ltsContext logging) (ltsNamespace logging) app
- newtype FlowId = FlowId Text
- instance LogItem FlowId where
- payloadKeys _ _ = AllKeys
- instance ToObject FlowId where
- toObject (FlowId flowid) = ["flowId" .= flowid, "test" .= ("bar" :: Text)]
- app :: KatipContext m => m ()
- app = do
- katipAddNamespace (Namespace ["cont"]) $ katipAddContext (FlowId "foo") $ logFM InfoS "Foobar"
- makeLogEnv :: IO LogEnv
- makeLogEnv = do
- let env = (Environment "start")
- handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2
- registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv (Namespace ["TestService"]) env
- loggingBracket :: (KatipContextTState -> IO c) -> IO c
- loggingBracket fun = do
- bracket makeLogEnv closeScribes $ \le -> do
- let
- logging = KatipContextTState
- { ltsLogEnv = le
- , ltsContext = liftPayload () -- this context will be attached to every log in your app and merged w/ subsequent contexts
- , ltsNamespace = "main"
- }
- fun logging
Add Comment
Please, Sign In to add comment