Guest User

Untitled

a guest
Mar 18th, 2018
96
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.40 KB | None | 0 0
  1. #!/usr/bin/env stack
  2. {- stack --install-ghc
  3. --resolver lts-10.7
  4. script
  5. --compile
  6. --package katip
  7. --package universum
  8. --package aeson
  9. -}
  10.  
  11. {-# LANGUAGE OverloadedStrings #-}
  12. {-# LANGUAGE OverloadedLists #-}
  13. {-# LANGUAGE NoImplicitPrelude #-}
  14.  
  15. import Data.Aeson
  16. import Katip
  17. import Katip.Monadic
  18. import Universum
  19.  
  20. main = do
  21. loggingBracket $ \logging ->
  22. runKatipContextT (ltsLogEnv logging) (ltsContext logging) (ltsNamespace logging) app
  23.  
  24. newtype FlowId = FlowId Text
  25.  
  26. instance LogItem FlowId where
  27. payloadKeys _ _ = AllKeys
  28.  
  29. instance ToObject FlowId where
  30. toObject (FlowId flowid) = ["flowId" .= flowid, "test" .= ("bar" :: Text)]
  31.  
  32. app :: KatipContext m => m ()
  33. app = do
  34. katipAddNamespace (Namespace ["cont"]) $ katipAddContext (FlowId "foo") $ logFM InfoS "Foobar"
  35.  
  36. makeLogEnv :: IO LogEnv
  37. makeLogEnv = do
  38. let env = (Environment "start")
  39. handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2
  40. registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv (Namespace ["TestService"]) env
  41.  
  42. loggingBracket :: (KatipContextTState -> IO c) -> IO c
  43. loggingBracket fun = do
  44. bracket makeLogEnv closeScribes $ \le -> do
  45. let
  46. logging = KatipContextTState
  47. { ltsLogEnv = le
  48. , ltsContext = liftPayload () -- this context will be attached to every log in your app and merged w/ subsequent contexts
  49. , ltsNamespace = "main"
  50. }
  51. fun logging
Add Comment
Please, Sign In to add comment