diff options
| author | tv <tv@krebsco.de> | 2026-02-21 14:18:13 +0100 |
|---|---|---|
| committer | tv <tv@krebsco.de> | 2026-02-21 22:22:17 +0100 |
| commit | 55d42f1dd83b428aa0f1352bc0ea1402b9c2b811 (patch) | |
| tree | 81d5e80b385de42a0d1b48d3edd0d2b66d858b2d /lib/G4fClient/LoggingKatip.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/LoggingKatip.hs')
| -rw-r--r-- | lib/G4fClient/LoggingKatip.hs | 117 |
1 files changed, 117 insertions, 0 deletions
diff --git a/lib/G4fClient/LoggingKatip.hs b/lib/G4fClient/LoggingKatip.hs new file mode 100644 index 0000000..3d258f7 --- /dev/null +++ b/lib/G4fClient/LoggingKatip.hs @@ -0,0 +1,117 @@ +{- + 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.LoggingKatip +Katip Logging functions +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module G4fClient.LoggingKatip where + +import qualified Control.Exception.Safe as E +import qualified Control.Monad.IO.Class as P +import qualified Control.Monad.Trans.Reader as P +import qualified Data.Text as T +import qualified Lens.Micro as L +import qualified System.IO as IO + +import Data.Text (Text) +import GHC.Exts (IsString(..)) + +import qualified Katip as LG + +-- * Type Aliases (for compatibility) + +-- | Runs a Katip logging block with the Log environment +type LogExecWithContext = forall m a. P.MonadIO m => + LogContext -> LogExec m a + +-- | A Katip logging block +type LogExec m a = LG.KatipT m a -> m a + +-- | A Katip Log environment +type LogContext = LG.LogEnv + +-- | A Katip Log severity +type LogLevel = LG.Severity + +-- * default logger + +-- | the default log environment +initLogContext :: IO LogContext +initLogContext = LG.initLogEnv "G4fClient" "dev" + +-- | Runs a Katip logging block with the Log environment +runDefaultLogExecWithContext :: LogExecWithContext +runDefaultLogExecWithContext = LG.runKatipT + +-- * stdout logger + +-- | Runs a Katip logging block with the Log environment +stdoutLoggingExec :: LogExecWithContext +stdoutLoggingExec = runDefaultLogExecWithContext + +-- | A Katip Log environment which targets stdout +stdoutLoggingContext :: LogContext -> IO LogContext +stdoutLoggingContext cxt = do + handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stdout (LG.permitItem LG.InfoS) LG.V2 + LG.registerScribe "stdout" handleScribe LG.defaultScribeSettings cxt + +-- * stderr logger + +-- | Runs a Katip logging block with the Log environment +stderrLoggingExec :: LogExecWithContext +stderrLoggingExec = runDefaultLogExecWithContext + +-- | A Katip Log environment which targets stderr +stderrLoggingContext :: LogContext -> IO LogContext +stderrLoggingContext cxt = do + handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stderr (LG.permitItem LG.InfoS) LG.V2 + LG.registerScribe "stderr" handleScribe LG.defaultScribeSettings cxt + +-- * Null logger + +-- | Disables Katip logging +runNullLogExec :: LogExecWithContext +runNullLogExec le (LG.KatipT f) = P.runReaderT f (L.set LG.logEnvScribes mempty le) + +-- * Log Msg + +-- | Log a katip message +_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m () +_log src level msg = do + LG.logMsg (fromString $ T.unpack src) level (LG.logStr msg) + +-- * Log Exceptions + +-- | re-throws exceptions after logging them +logExceptions + :: (LG.Katip m, E.MonadCatch m, Applicative m) + => Text -> m a -> m a +logExceptions src = + E.handle + (\(e :: E.SomeException) -> do + _log src LG.ErrorS ((T.pack . show) e) + E.throw e) + +-- * Log Level + +levelInfo :: LogLevel +levelInfo = LG.InfoS + +levelError :: LogLevel +levelError = LG.ErrorS + +levelDebug :: LogLevel +levelDebug = LG.DebugS |
