aboutsummaryrefslogtreecommitdiffstats
path: root/lib/G4fClient/LoggingMonadLogger.hs
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2026-02-21 14:18:13 +0100
committertv <tv@krebsco.de>2026-02-21 22:22:17 +0100
commit55d42f1dd83b428aa0f1352bc0ea1402b9c2b811 (patch)
tree81d5e80b385de42a0d1b48d3edd0d2b66d858b2d /lib/G4fClient/LoggingMonadLogger.hs
generate initial commit
Generate haskell-http-client from running g4f v-7.1.4. Server started like this: python -m g4f --port 8080 --debug Code generated like this: openapi-generator-cli generate \ -i http://localhost:8080/openapi.json \ -g haskell-http-client \ --skip-validate-spec \ -o g4f-client \ --additional-properties=cabalPackage=g4f-client,cabalVersion=7.1.4,baseModule=G4fApi
Diffstat (limited to 'lib/G4fClient/LoggingMonadLogger.hs')
-rw-r--r--lib/G4fClient/LoggingMonadLogger.hs126
1 files changed, 126 insertions, 0 deletions
diff --git a/lib/G4fClient/LoggingMonadLogger.hs b/lib/G4fClient/LoggingMonadLogger.hs
new file mode 100644
index 0000000..70ab956
--- /dev/null
+++ b/lib/G4fClient/LoggingMonadLogger.hs
@@ -0,0 +1,126 @@
+{-
+ FastAPI
+
+ No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)
+
+ OpenAPI Version: 3.1.0
+ FastAPI API version: 0.1.0
+ Generated by OpenAPI Generator (https://openapi-generator.tech)
+-}
+
+{-|
+Module : G4fClient.LoggingMonadLogger
+monad-logger Logging functions
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module G4fClient.LoggingMonadLogger where
+
+import qualified Control.Exception.Safe as E
+import qualified Control.Monad.IO.Class as P
+import qualified Data.Text as T
+import qualified Data.Time as TI
+
+import Data.Text (Text)
+
+import qualified Control.Monad.Logger as LG
+
+-- * Type Aliases (for compatibility)
+
+-- | Runs a monad-logger block with the filter predicate
+type LogExecWithContext = forall m a. P.MonadIO m =>
+ LogContext -> LogExec m a
+
+-- | A monad-logger block
+type LogExec m a = LG.LoggingT m a -> m a
+
+-- | A monad-logger filter predicate
+type LogContext = LG.LogSource -> LG.LogLevel -> Bool
+
+-- | A monad-logger log level
+type LogLevel = LG.LogLevel
+
+-- * default logger
+
+-- | the default log environment
+initLogContext :: IO LogContext
+initLogContext = pure infoLevelFilter
+
+-- | Runs a monad-logger block with the filter predicate
+runDefaultLogExecWithContext :: LogExecWithContext
+runDefaultLogExecWithContext = runNullLogExec
+
+-- * stdout logger
+
+-- | Runs a monad-logger block targeting stdout, with the filter predicate
+stdoutLoggingExec :: LogExecWithContext
+stdoutLoggingExec cxt = LG.runStdoutLoggingT . LG.filterLogger cxt
+
+-- | @pure@
+stdoutLoggingContext :: LogContext -> IO LogContext
+stdoutLoggingContext = pure
+
+-- * stderr logger
+
+-- | Runs a monad-logger block targeting stderr, with the filter predicate
+stderrLoggingExec :: LogExecWithContext
+stderrLoggingExec cxt = LG.runStderrLoggingT . LG.filterLogger cxt
+
+-- | @pure@
+stderrLoggingContext :: LogContext -> IO LogContext
+stderrLoggingContext = pure
+
+-- * Null logger
+
+-- | Disables monad-logger logging
+runNullLogExec :: LogExecWithContext
+runNullLogExec = const (`LG.runLoggingT` nullLogger)
+
+-- | monad-logger which does nothing
+nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()
+nullLogger _ _ _ _ = return ()
+
+-- * Log Msg
+
+-- | Log a message using the current time
+_log :: (P.MonadIO m, LG.MonadLogger m) => Text -> LG.LogLevel -> Text -> m ()
+_log src level msg = do
+ now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)
+ LG.logOtherNS ("G4fClient." <> src) level ("[" <> now <> "] " <> msg)
+ where
+ formatTimeLog =
+ T.pack . TI.formatTime TI.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z"
+
+-- * Log Exceptions
+
+-- | re-throws exceptions after logging them
+logExceptions
+ :: (LG.MonadLogger m, E.MonadCatch m, P.MonadIO m)
+ => Text -> m a -> m a
+logExceptions src =
+ E.handle
+ (\(e :: E.SomeException) -> do
+ _log src LG.LevelError ((T.pack . show) e)
+ E.throw e)
+
+-- * Log Level
+
+levelInfo :: LogLevel
+levelInfo = LG.LevelInfo
+
+levelError :: LogLevel
+levelError = LG.LevelError
+
+levelDebug :: LogLevel
+levelDebug = LG.LevelDebug
+
+-- * Level Filter
+
+minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool
+minLevelFilter l _ l' = l' >= l
+
+infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
+infoLevelFilter = minLevelFilter LG.LevelInfo