Using MonadLogger without LoggingT in Haskell
Last active
September 26, 2023 19:11
-
-
Save nicolashery/a5eceb7603262f79f08d8b29ed41aef6 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Main (main) where | |
| import Relude | |
| import Blammo.Logging.Simple qualified as Blammo (runSimpleLoggingT) | |
| import Control.Monad.Logger (LoggingT, MonadLogger) | |
| import Control.Monad.Logger.Aeson (Message ((:#)), (.=)) | |
| import Control.Monad.Logger.Aeson qualified as LoggerJson ( | |
| logInfo, | |
| logWarn, | |
| runStdoutLoggingT, | |
| ) | |
| import Control.Monad.Logger.CallStack qualified as Logger ( | |
| logInfo, | |
| logWarn, | |
| runStdoutLoggingT, | |
| ) | |
| data Item = Item | |
| { itemId :: Text | |
| , itemContents :: Text | |
| } | |
| getItem :: IO Item | |
| getItem = | |
| pure | |
| $ Item | |
| { itemId = "652412308" | |
| , itemContents = "<p>Hello world!</p>" | |
| } | |
| data AppEnv = AppEnv | |
| { appName :: Text | |
| , appVersion :: Text | |
| } | |
| newtype App a = App | |
| {unApp :: ReaderT AppEnv (LoggingT IO) a} | |
| deriving newtype | |
| ( Functor | |
| , Applicative | |
| , Monad | |
| , MonadIO | |
| , MonadReader AppEnv | |
| , MonadLogger | |
| ) | |
| runApp :: AppEnv -> (LoggingT IO a -> IO a) -> App a -> IO a | |
| runApp env runLogging action = | |
| runLogging $ runReaderT (unApp action) env | |
| appPlain :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m () | |
| appPlain = do | |
| appName <- asks appName | |
| Logger.logInfo $ "App started: " <> "appName=" <> appName | |
| item <- liftIO getItem | |
| Logger.logWarn | |
| $ "Skipping invalid item: " | |
| <> "appName=" | |
| <> appName | |
| <> " itemId=" | |
| <> itemId item | |
| appJson :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m () | |
| appJson = do | |
| appName <- asks appName | |
| LoggerJson.logInfo $ "App started" :# ["appName" .= appName] | |
| item <- liftIO getItem | |
| LoggerJson.logWarn | |
| $ "Skipping invalid item" | |
| :# [ "appName" .= appName | |
| , "itemId" .= itemId item | |
| ] | |
| mainPlain :: IO () | |
| mainPlain = do | |
| let appEnv = | |
| AppEnv | |
| { appName = "example-1a" | |
| , appVersion = "1.0.0" | |
| } | |
| runApp appEnv Logger.runStdoutLoggingT appPlain | |
| mainJson :: IO () | |
| mainJson = do | |
| let appEnv = | |
| AppEnv | |
| { appName = "example-1b" | |
| , appVersion = "1.0.0" | |
| } | |
| runApp appEnv LoggerJson.runStdoutLoggingT appJson | |
| mainBlammo :: IO () | |
| mainBlammo = do | |
| let appEnv = | |
| AppEnv | |
| { appName = "example-1c" | |
| , appVersion = "1.0.0" | |
| } | |
| runApp appEnv Blammo.runSimpleLoggingT appJson | |
| main :: IO () | |
| main = do | |
| mainPlain | |
| putStrLn "" | |
| mainJson | |
| putStrLn "" | |
| mainBlammo |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| cabal-version: 3.0 | |
| name: monadlogger-without-loggingt | |
| version: 1.0.0 | |
| common options | |
| build-depends: | |
| , Blammo | |
| , monad-logger | |
| , monad-logger-aeson | |
| , relude | |
| ghc-options: | |
| -Wall | |
| -Wcompat | |
| -Widentities | |
| -Wincomplete-uni-patterns | |
| -Wincomplete-record-updates | |
| -Wredundant-constraints | |
| -Wmissing-export-lists | |
| -Wpartial-fields | |
| -Wunused-packages | |
| default-language: GHC2021 | |
| default-extensions: | |
| DeriveAnyClass | |
| DerivingStrategies | |
| DerivingVia | |
| DuplicateRecordFields | |
| NoImplicitPrelude | |
| OverloadedRecordDot | |
| OverloadedStrings | |
| StrictData | |
| executable monadlogger-without-loggingt | |
| import: options | |
| main-is: Main.hs | |
| hs-source-dirs: . |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment