-
Notifications
You must be signed in to change notification settings - Fork 6k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
[haskell-http-client] use katip logger, default strict
* change strictFields cli option default to True; * use katip logging; add cli-option for monad-logger * fix date parsing * remove package.yaml
- Loading branch information
1 parent
8067612
commit 0bf0a87
Showing
62 changed files
with
1,321 additions
and
1,265 deletions.
There are no files selected for viewing
This file contains 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
This file contains 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
108 changes: 108 additions & 0 deletions
108
modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingKatip.mustache
This file contains 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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,108 @@ | ||
| {-| | ||
| Module : {{title}}.Logging | ||
| Katip Logging functions | ||
| -} | ||
|
|
||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
|
|
||
| module {{title}}.Logging where | ||
|
|
||
| import Data.Text (Text) | ||
| import GHC.Exts (IsString(..)) | ||
|
|
||
| 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 qualified Katip as LG | ||
|
|
||
| -- * Type Aliases (for compatability) | ||
|
|
||
| -- | Runs a Katip logging block with the Log environment | ||
| type LogExecWithContext = forall m. P.MonadIO m => | ||
| LogContext -> LogExec m | ||
|
|
||
| -- | A Katip logging block | ||
| type LogExec m = forall 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 "{{title}}" "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.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.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 | ||
|
|
Oops, something went wrong.