Skip to content

Instantly share code, notes, and snippets.

@nicolashery

nicolashery/.monadlogger-without-loggingt.md

Last active September 26, 2023 19:11
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save nicolashery/a5eceb7603262f79f08d8b29ed41aef6 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save nicolashery/a5eceb7603262f79f08d8b29ed41aef6 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. nicolashery revised this gist Sep 26, 2023. 2 changed files with 92 additions and 44 deletions.
    68 changes: 46 additions & 22 deletions WithLoggingT.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -21,17 +21,23 @@ data Item = Item
    , itemContents :: Text
    }

    getItem :: IO Item
    getItem =
    fetchItem :: Text -> IO Item
    fetchItem _itemUrl =
    pure
    $ Item
    { itemId = "652412308"
    , itemContents = "<p>Hello world!</p>"
    }

    isInvalidItem :: Item -> Bool
    isInvalidItem _item = True

    processItem :: (MonadIO m) => Item -> m ()
    processItem _item = pure ()

    data AppEnv = AppEnv
    { appName :: Text
    , appVersion :: Text
    , appItemUrl :: Text
    }

    newtype App a = App
    @@ -49,35 +55,53 @@ 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 ()
    actionPlain :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    actionPlain = do
    itemUrl <- asks appItemUrl
    Logger.logInfo $ "Fetching item: " <> "itemUrl=" <> itemUrl
    item <- liftIO $ fetchItem itemUrl
    if isInvalidItem item
    then
    Logger.logWarn
    $ "Skipping invalid item: "
    <> "itemUrl="
    <> itemUrl
    <> " itemId="
    <> itemId item
    else processItem item

    appPlain :: App ()
    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 ()
    actionPlain

    actionJson :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    actionJson = do
    itemUrl <- asks appItemUrl
    LoggerJson.logInfo $ "Fetching item" :# ["itemUrl" .= itemUrl]
    item <- liftIO $ fetchItem itemUrl
    if isInvalidItem item
    then
    LoggerJson.logWarn
    $ "Skipping invalid item"
    :# [ "itemUrl" .= itemUrl
    , "itemId" .= itemId item
    ]
    else processItem item

    appJson :: App ()
    appJson = do
    appName <- asks appName
    LoggerJson.logInfo $ "App started" :# ["appName" .= appName]
    item <- liftIO getItem
    LoggerJson.logWarn
    $ "Skipping invalid item"
    :# [ "appName" .= appName
    , "itemId" .= itemId item
    ]
    actionJson

    mainPlain :: IO ()
    mainPlain = do
    let appEnv =
    AppEnv
    { appName = "example-1a"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    }
    runApp appEnv Logger.runStdoutLoggingT appPlain

    @@ -86,7 +110,7 @@ mainJson = do
    let appEnv =
    AppEnv
    { appName = "example-1b"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    }
    runApp appEnv LoggerJson.runStdoutLoggingT appJson

    @@ -95,7 +119,7 @@ mainBlammo = do
    let appEnv =
    AppEnv
    { appName = "example-1c"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    }
    runApp appEnv Blammo.runSimpleLoggingT appJson

    68 changes: 46 additions & 22 deletions WithoutLoggingT.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -31,17 +31,23 @@ data Item = Item
    , itemContents :: Text
    }

    getItem :: IO Item
    getItem =
    fetchItem :: Text -> IO Item
    fetchItem _itemUrl =
    pure
    $ Item
    { itemId = "652412308"
    , itemContents = "<p>Hello world!</p>"
    }

    isInvalidItem :: Item -> Bool
    isInvalidItem _item = True

    processItem :: (MonadIO m) => Item -> m ()
    processItem _item = pure ()

    data AppEnv = AppEnv
    { appName :: Text
    , appVersion :: Text
    , appItemUrl :: Text
    , appLogFunc :: LogFunc
    }

    @@ -64,36 +70,54 @@ runApp :: AppEnv -> App a -> IO a
    runApp env action =
    runReaderT (unApp action) env

    appPlain :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    actionPlain :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    actionPlain = do
    itemUrl <- asks appItemUrl
    Logger.logInfo $ "Fetching item: " <> "itemUrl=" <> itemUrl
    item <- liftIO $ fetchItem itemUrl
    if isInvalidItem item
    then
    Logger.logWarn
    $ "Skipping invalid item: "
    <> "itemUrl="
    <> itemUrl
    <> " itemId="
    <> itemId item
    else processItem item

    appPlain :: App ()
    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 ()
    actionPlain

    actionJson :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    actionJson = do
    itemUrl <- asks appItemUrl
    LoggerJson.logInfo $ "Fetching item" :# ["itemUrl" .= itemUrl]
    item <- liftIO $ fetchItem itemUrl
    if isInvalidItem item
    then
    LoggerJson.logWarn
    $ "Skipping invalid item"
    :# [ "itemUrl" .= itemUrl
    , "itemId" .= itemId item
    ]
    else processItem item

    appJson :: App ()
    appJson = do
    appName <- asks appName
    LoggerJson.logInfo $ "App started" :# ["appName" .= appName]
    item <- liftIO getItem
    LoggerJson.logWarn
    $ "Skipping invalid item"
    :# [ "appName" .= appName
    , "itemId" .= itemId item
    ]
    actionJson

    mainPlain :: IO ()
    mainPlain = do
    let logFunc = Logger.defaultOutput stdout
    appEnv =
    AppEnv
    { appName = "example-2a"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    , appLogFunc = logFunc
    }
    runApp appEnv appPlain
    @@ -104,7 +128,7 @@ mainJson = do
    appEnv =
    AppEnv
    { appName = "example-2b"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    , appLogFunc = logFunc
    }
    runApp appEnv appJson
    @@ -119,7 +143,7 @@ mainBlammo = do
    let appEnv =
    AppEnv
    { appName = "example-2c"
    , appVersion = "1.0.0"
    , appItemUrl = "https://www.example.com/item"
    , appLogFunc = logFunc
    }
    runApp appEnv appJson
  2. nicolashery revised this gist Sep 5, 2023. 3 changed files with 140 additions and 2 deletions.
    0 Main.hs → WithLoggingT.hs
    View file
    File renamed without changes.
    133 changes: 133 additions & 0 deletions WithoutLoggingT.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,133 @@
    module Main (main) where

    import Relude

    import Blammo.Logging.Simple qualified as Blammo (runSimpleLoggingT)
    import Control.Monad.Logger (
    Loc,
    LogLevel,
    LogSource,
    LogStr,
    MonadLogger (monadLoggerLog),
    MonadLoggerIO (askLoggerIO),
    ToLogStr (toLogStr),
    )
    import Control.Monad.Logger.Aeson (Message ((:#)), (.=))
    import Control.Monad.Logger.Aeson qualified as LoggerJson (
    defaultOutput,
    logInfo,
    logWarn,
    )
    import Control.Monad.Logger.CallStack qualified as Logger (
    defaultOutput,
    logInfo,
    logWarn,
    )

    type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()

    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
    , appLogFunc :: LogFunc
    }

    newtype App a = App
    {unApp :: ReaderT AppEnv IO a}
    deriving newtype
    ( Functor
    , Applicative
    , Monad
    , MonadIO
    , MonadReader AppEnv
    )

    instance MonadLogger App where
    monadLoggerLog loc logSource logLevel msg = do
    logFunc <- asks appLogFunc
    liftIO $ logFunc loc logSource logLevel (toLogStr msg)

    runApp :: AppEnv -> App a -> IO a
    runApp env action =
    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 logFunc = Logger.defaultOutput stdout
    appEnv =
    AppEnv
    { appName = "example-2a"
    , appVersion = "1.0.0"
    , appLogFunc = logFunc
    }
    runApp appEnv appPlain

    mainJson :: IO ()
    mainJson = do
    let logFunc = LoggerJson.defaultOutput stdout
    appEnv =
    AppEnv
    { appName = "example-2b"
    , appVersion = "1.0.0"
    , appLogFunc = logFunc
    }
    runApp appEnv appJson

    getBlammoLogFunc :: IO LogFunc
    getBlammoLogFunc =
    Blammo.runSimpleLoggingT askLoggerIO

    mainBlammo :: IO ()
    mainBlammo = do
    logFunc <- getBlammoLogFunc
    let appEnv =
    AppEnv
    { appName = "example-2c"
    , appVersion = "1.0.0"
    , appLogFunc = logFunc
    }
    runApp appEnv appJson

    main :: IO ()
    main = do
    mainPlain
    putStrLn ""
    mainJson
    putStrLn ""
    mainBlammo
    9 changes: 7 additions & 2 deletions monadlogger-without-loggingt.cabal
    View file
    Original file line number Diff line number Diff line change
    @@ -29,7 +29,12 @@ common options
    OverloadedStrings
    StrictData

    executable monadlogger-without-loggingt
    executable with-loggingt
    import: options
    main-is: Main.hs
    main-is: WithLoggingT.hs
    hs-source-dirs: .

    executable without-loggingt
    import: options
    main-is: WithoutLoggingT.hs
    hs-source-dirs: .
  3. nicolashery revised this gist Sep 1, 2023. 2 changed files with 33 additions and 15 deletions.
    46 changes: 33 additions & 13 deletions Main.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -2,6 +2,7 @@ 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 (
    @@ -35,14 +36,21 @@ data AppEnv = AppEnv

    newtype App a = App
    {unApp :: ReaderT AppEnv (LoggingT IO) a}
    deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv, MonadLogger)
    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

    app1a :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    app1a = do
    appPlain :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    appPlain = do
    appName <- asks appName
    Logger.logInfo $ "App started: " <> "appName=" <> appName
    item <- liftIO getItem
    @@ -53,8 +61,8 @@ app1a = do
    <> " itemId="
    <> itemId item

    app1b :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    app1b = do
    appJson :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    appJson = do
    appName <- asks appName
    LoggerJson.logInfo $ "App started" :# ["appName" .= appName]
    item <- liftIO getItem
    @@ -64,25 +72,37 @@ app1b = do
    , "itemId" .= itemId item
    ]

    main1a :: IO ()
    main1a = do
    mainPlain :: IO ()
    mainPlain = do
    let appEnv =
    AppEnv
    { appName = "example-1a"
    , appVersion = "1.0.0"
    }
    runApp appEnv Logger.runStdoutLoggingT app1a
    runApp appEnv Logger.runStdoutLoggingT appPlain

    main1b :: IO ()
    main1b = do
    mainJson :: IO ()
    mainJson = do
    let appEnv =
    AppEnv
    { appName = "example-1b"
    , appVersion = "1.0.0"
    }
    runApp appEnv LoggerJson.runStdoutLoggingT app1b
    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
    main1a
    main1b
    mainPlain
    putStrLn ""
    mainJson
    putStrLn ""
    mainBlammo
    2 changes: 0 additions & 2 deletions monadlogger-without-loggingt.cabal
    View file
    Original file line number Diff line number Diff line change
    @@ -4,12 +4,10 @@ version: 1.0.0

    common options
    build-depends:
    , base
    , Blammo
    , monad-logger
    , monad-logger-aeson
    , relude
    , transformers
    ghc-options:
    -Wall
    -Wcompat
  4. nicolashery revised this gist Sep 1, 2023. 2 changed files with 125 additions and 0 deletions.
    88 changes: 88 additions & 0 deletions Main.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,88 @@
    module Main (main) where

    import Relude

    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

    app1a :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    app1a = do
    appName <- asks appName
    Logger.logInfo $ "App started: " <> "appName=" <> appName
    item <- liftIO getItem
    Logger.logWarn
    $ "Skipping invalid item: "
    <> "appName="
    <> appName
    <> " itemId="
    <> itemId item

    app1b :: (MonadReader AppEnv m, MonadLogger m, MonadIO m) => m ()
    app1b = do
    appName <- asks appName
    LoggerJson.logInfo $ "App started" :# ["appName" .= appName]
    item <- liftIO getItem
    LoggerJson.logWarn
    $ "Skipping invalid item"
    :# [ "appName" .= appName
    , "itemId" .= itemId item
    ]

    main1a :: IO ()
    main1a = do
    let appEnv =
    AppEnv
    { appName = "example-1a"
    , appVersion = "1.0.0"
    }
    runApp appEnv Logger.runStdoutLoggingT app1a

    main1b :: IO ()
    main1b = do
    let appEnv =
    AppEnv
    { appName = "example-1b"
    , appVersion = "1.0.0"
    }
    runApp appEnv LoggerJson.runStdoutLoggingT app1b

    main :: IO ()
    main = do
    main1a
    main1b
    37 changes: 37 additions & 0 deletions monadlogger-without-loggingt.cabal
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,37 @@
    cabal-version: 3.0
    name: monadlogger-without-loggingt
    version: 1.0.0

    common options
    build-depends:
    , base
    , Blammo
    , monad-logger
    , monad-logger-aeson
    , relude
    , transformers
    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: .
  5. nicolashery created this gist Sep 1, 2023.
    1 change: 1 addition & 0 deletions .monadlogger-without-loggingt.md
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1 @@
    Using `MonadLogger` without `LoggingT` in Haskell