packages feed

om-logging (empty) → 1.1.0.4

raw patch · 5 files changed

+368/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, fast-logger, monad-logger, om-show, split, text, time

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Owens Murray, LLC.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,32 @@+# om-logging++This package provides various combinators for composing loggers for use+with the [monad-logger](https://hackage.haskell.org/package/monad-logger)+package.++It also provides an opinion about what a good log message looks like.++For instance, the opinionated "standard" log format is defined using+the other combinators:++```haskell+{- |+  Log to the indicated destination, applying the "standard" filters+  and formats.+-}+withStandardFormat+  :: LogLevel {- ^ The minimum log level that will be logged. -}+  -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ The base logger. -}+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withStandardFormat logLevel =+  filterLogging (levelFilter logLevel)+  . withPrefix ": "+  . withThread+  . withPackage+  . withLevel+  . withTime+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ om-logging.cabal view
@@ -0,0 +1,46 @@+cabal-version:       3.0+name:                om-logging+version:             1.1.0.4+synopsis:            Opinionated logging utilities.+description:         A set of logging combinators for use with monad-logger.+homepage:            https://github.com/owensmurray/om-logging+license:             MIT+license-file:        LICENSE+author:              Rick Owens+maintainer:          rick@owensmurray.com+copyright:           2021 Owens Murray, LLC.+category:            logging+build-type:          Simple+extra-source-files:+  README.md+  LICENSE++common dependencies+  build-depends:+    , aeson        >= 2.0.3.0   && < 2.1+    , base         >= 4.15.0.0  && < 4.16+    , bytestring   >= 0.10.12.1 && < 0.11+    , fast-logger  >= 3.1.1     && < 3.2+    , monad-logger >= 0.3.36    && < 0.4+    , om-show      >= 0.1.2.0   && < 0.2+    , split        >= 0.2.3.4   && < 0.3+    , text         >= 1.2.5.0   && < 1.3+    , time         >= 1.9.3     && < 1.10++common warnings+  ghc-options:+    -Wmissing-deriving-strategies+    -Wmissing-export-lists+    -Wmissing-import-lists+    -Wredundant-constraints+    -Wall++library+  import: warnings, dependencies+  exposed-modules:     +    OM.Logging+  -- other-modules:       +  -- other-extensions:    +  hs-source-dirs:      src+  default-language:    Haskell2010+
+ src/OM/Logging.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+  Description: Logging utilities.++  Various combinators for composing "monad-logger" loggers.+-}+module OM.Logging (+  -- * Standard OM logging+  standardLogging,+  withStandardFormat,++  -- * Logging Combinators+  withTime,+  withThread,+  withLevel,+  withPrefix,+  withPackage,++  -- ** Filters+  filterLogging,+  levelFilter,++  -- ** Destinations+  teeLogging,+  stdoutLogging,+  fdLogging,++  -- * Other types+  parseLevel,+  JSONLevel(..),+) where+++import Control.Concurrent (myThreadId)+import Control.Monad (when)+import Control.Monad.Logger (LogLevel(LevelDebug, LevelError, LevelInfo,+  LevelOther, LevelWarn), Loc, LogSource, LogStr, loc_package)+import Data.Aeson (FromJSON(parseJSON), Value(String))+import Data.List (intercalate)+import Data.List.Split (splitOn)+import Data.String (IsString)+import Data.Text (Text)+import Data.Time (getCurrentTime)+import Data.Time.Format (defaultTimeLocale, formatTime)+import OM.Show (showt)+import System.IO (Handle, hFlush, stdout)+import System.Log.FastLogger (fromLogStr, toLogStr)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Text as T+++{- | Log to more than one logging destination. -}+teeLogging+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ Destination 1. -}+  -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ Destination 2. -}+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+teeLogging logging1 logging2 loc src level msg = do+  logging1 loc src level msg+  logging2 loc src level msg+++{- |+  Filter out some log messages. Only messages matching the predicate+  are logged to the underlying logger.+-}+filterLogging+  :: (Loc -> LogSource -> LogLevel -> LogStr -> Bool)+     {- ^ The filter to apply. -}+  -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+     {- ^ The downstream logging destination. -}+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+filterLogging p base loc src level msg =+  when (p loc src level msg)+    (base loc src level msg)+++{- |+  @levelFilter level@ is a filter predicate that matches all log messages+  with @level@ or above.+-}+levelFilter :: LogLevel -> Loc -> LogSource -> LogLevel -> LogStr -> Bool+levelFilter target _ _ level _ = level >= target+++{- | Prepend the 'Control.Concurrent.ThreadId' to the beginning of the log. -}+withThread+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withThread base loc src level msg = do+  tid <- myThreadId+  base loc src level (toLogStr (squareBracket (showt tid :: Text)) <> msg)+++{- | Add timing information to the beginning of logs. -}+withTime+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withTime base loc src level msg = do+  now <- getCurrentTime+  let+    time :: LogStr+    time =+      toLogStr+      . squareBracket+      . T.pack+      . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%06Q %Z"+      $ now+  base loc src level (time <> msg)+++{- | Add the originating package to the log message. -}+withPackage+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withPackage base loc src level msg =+  let+    {-+      The package information looks like this+      `om-legion-6.4.1.1-LnoDD8xLijN7DglolZGFIp`, but we only want the+      actual package name, which is why we do the `reverse . split`+      business.+    -}+    package =+      toLogStr+      . squareBracket+      $ case+          reverse+          . splitOn "-"+          . loc_package+          $ loc+        of+          _hash : _version : nameComponents ->+            intercalate "-" (reverse nameComponents)+          _ -> loc_package loc+  in base loc src level (package <> msg)+++{- | Add the Logging level to the log output. -}+withLevel+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withLevel base loc src level msg =+  let+    levelStr :: LogStr+    levelStr = squareBracket . toLogStr . showLevel $ level+  in+    base loc src level (levelStr <> msg)+++{- | Prefix a fixed string to the log output. -}+withPrefix+  :: LogStr+  -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withPrefix prefix base loc src level msg =+  base loc src level (prefix <> msg)+++{- | Help with putting things in square brackets. -}+squareBracket :: (IsString s, Monoid s) => s -> s+squareBracket t = "[" <> t <> "]"+++{- | Stringify a log level. -}+showLevel :: LogLevel -> Text+showLevel (LevelOther level) = T.toUpper level+showLevel level = T.toUpper . T.drop 5 . showt $ level+++{- |+  Log messages to stdout. This is very bare bones. It only logs the+  message itself with no other information. It is meant to be used in+  conjunction with some of the other combinators, like `withLevel`.+-}+stdoutLogging :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+stdoutLogging = fdLogging stdout+++{- | Like 'stdoutLogging', but log to a file handle. -}+fdLogging :: Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()+fdLogging fd _ _ _ msg = do+  BS8.hPutStr fd (fromLogStr msg <> "\n")+  hFlush fd+++{- | The standard logging for most OM programs. -}+standardLogging+  :: LogLevel+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+standardLogging logLevel =+  withStandardFormat logLevel stdoutLogging+++{- |+  Log to the indicated destination, applying the "standard" filters+  and formats.+-}+withStandardFormat+  :: LogLevel {- ^ The minimum log level that will be logged. -}+  -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ The base logger. -}+  -> Loc+  -> LogSource+  -> LogLevel+  -> LogStr+  -> IO ()+withStandardFormat logLevel =+  filterLogging (levelFilter logLevel)+  . withPrefix ": "+  . withThread+  . withPackage+  . withLevel+  . withTime+++{- | A FromJSON instance to figure out the logging level. -}+newtype JSONLevel = JSONLevel {+    unJSONLevel :: LogLevel+  }+instance FromJSON JSONLevel where+  parseJSON (String str) =+    return (JSONLevel (parseLevel str))+  parseJSON v =+    fail $ "Can't parse logging level from: " ++ show v+++{- | Parse a logging level from a string. -}+parseLevel :: Text -> LogLevel+parseLevel "DEBUG" = LevelDebug+parseLevel "INFO" = LevelInfo+parseLevel "WARN" = LevelWarn+parseLevel "ERROR" = LevelError+parseLevel other = LevelOther other++