co-log-polysemy-formatting (empty) → 0.1.0.0

raw patch · 13 files changed

+777/−0 lines, 13 filesdep +ansi-terminaldep +basedep +co-logsetup-changedbinary-added

Dependencies added: ansi-terminal, base, co-log, co-log-core, co-log-polysemy, co-log-polysemy-formatting, formatting, polysemy, polysemy-plugin, text, time

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +77/−0
• Setup.hs +2/−0
• co-log-polysemy-formatting.cabal +79/−0
• example/Main.hs +60/−0
• example/output.png binary
• src/Colog/Polysemy/Formatting.hs +203/−0
• src/Colog/Polysemy/Formatting/Color.hs +45/−0
• src/Colog/Polysemy/Formatting/LogEnv.hs +27/−0
• src/Colog/Polysemy/Formatting/Render.hs +153/−0
• src/Colog/Polysemy/Formatting/ThreadTimeMessage.hs +66/−0
• src/Colog/Polysemy/Formatting/WithLog.hs +30/−0

@@ -0,0 +1,5 @@+# Revision history for co-log-polysemy-formatting++## 0.1.0.0 -- 2020-10-12++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2020, Alex Chapman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alex Chapman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,77 @@+# co-log-polysemy-formatting [![Build Status](https://travis-ci.org/AJChapman/co-log-polysemy-formatting.png)](https://travis-ci.org/AJChapman/co-log-polysemy-formatting) [![Hackage](https://img.shields.io/hackage/v/co-log-polysemy-formatting.svg?style=flat)](https://hackage.haskell.org/package/co-log-polysemy-formatting)++co-log-polysemy-formatting gives you a Polysemy logging effect for high quality (unstructured) logs.++It does this by tying together several excellent packages:++- [co-log],+- [co-log-polysemy], and+- [formatting].++To get started, see [the haddock documentation](https://hackage.haskell.org/package/co-log-polysemy-formatting-0.1.0.0/docs/Colog-Polysemy-Formatting.html).++## Output format++The output format is customisable, but by default it includes:++- The message severity,+- a message timestamp, with nanosecond accuracy,+- a thread Id,+- a source location, and+- your log message, formatted using [formatting].++![example output](example/output.png)++The colours show up if your terminal supports them, otherwise it will fall back to greyscale, including if you pipe the output to a file.++## formatting messages++Our logging functions, e.g. `logInfo`, take a [formatting] formatter rather than a `String`/`Text`/etc.+This makes it quick and easy to build your log messages from whatever type you have at hand, and still allows you to directly log string literals thanks to the `OverloadedStrings` language extension:++```haskell+{-# LANGUAGE OverloadedStrings #-}++myString :: String+myString = "this is my string"++myStrictText :: Data.Text.Text+myStrictText = "this is my strict text"++myLazyText :: Data.Text.Lazy.Text+myLazyText = "this is my lazy text"++-- These will all work:+logInfo "a string literal"+logInfo string myString+logInfo stext myStrictText+logInfo text myLazyText+logInfo (string % ", " % stext % ", " % text) myString myStrictText myLazyText++-- And logging structures is easy too:+data Person = Person { personName :: Text, personAge :: Int }++myPerson :: Person+myPerson = Person "Dave" 16++logInfo ("The person's name is " % accessed personName text <> ", and their age is " % accessed personAge int) myPerson++-- Or with lenses+data Person' = Person' { _personName :: Text, _personAge :: Int }+makeLenses ''Person'++myPerson' :: Person'+myPerson' = Person' "Dave" 16++logInfo ("The person's name is " % viewed personName text <> ", and their age is " % viewed personAge int) myPerson'+```++## Why not just use co-log-polysemy?++[co-log-polysemy] is a generic logging effect that leaves many decisions up to you, such as your logging format and your logging message type.+But if you want something that just works, with good defaults, then co-log-polysemy-formatting will get you there faster.+And you're still using co-log-polysemy under the hood -- we even re-export some of its functions for you -- we've just added a few features on top.++[co-log]: https://hackage.haskell.org/package/co-log+[co-log-polysemy]: https://hackage.haskell.org/package/co-log-polysemy+[formatting]: https://github.com/AJChapman/formatting#readme

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,79 @@+cabal-version:       2.4+name:                co-log-polysemy-formatting+version:             0.1.0.0+synopsis:            A Polysemy logging effect for high quality (unstructured) logs.+description:         co-log-polysemy-formatting builds on the co-log-polysemy package, adding terminal colours, log severity, timestamps, callers, thread ids, and a flexible log format with good defaults. It also allows you to use the formatting library for formatting your log messages.+homepage:         https://github.com/AJChapman/co-log-polysemy-formatting/README.md+bug-reports:         https://github.com/AJChapman/co-log-polysemy-formatting/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Alex Chapman+maintainer:          alex@farfromthere.net+copyright:           2020 Alex Chapman+category:            Logging+extra-source-files:  CHANGELOG.md+                     README.md+extra-doc-files:     example/output.png+tested-with:           GHC == 8.4.4+                     , GHC == 8.6.5+                     , GHC == 8.8.4+                     , GHC == 8.10.1++common deps+  build-depends:       base             >= 4.11.0.0 && < 5+                     , ansi-terminal   ^>= 0.10.3+                     , co-log          ^>= 0.4.0.1+                     , co-log-core     ^>= 0.2.1.1+                     , co-log-polysemy ^>= 0.0.1.1+                     , formatting      ^>= 7.1.0+                     , polysemy        ^>= 1.3.0.0+                     , text             >= 0.11.0.8 && < 1.3+                     , time             >= 1.8.0.2 && < 1.10++-- Warnings list list taken from+-- https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3+-- Enable all warnings with -Weverything, then disable the ones we+-- don’t care about+  default-language:  Haskell2010+  ghc-options:       -Weverything+                     -Wno-all-missed-specialisations+                     -Wno-implicit-prelude+                     -Wno-missed-specialisations+                     -Wno-missing-exported-signatures+                     -Wno-missing-import-lists+                     -Wno-missing-local-signatures+                     -Wno-monomorphism-restriction+                     -Wno-missing-deriving-strategies+                     -Wno-safe+                     -Wno-unsafe+                     -fprint-potential-instances+  if impl(ghc >= 8.10)+    ghc-options:     -Wno-prepositive-qualified-module+                     -Wno-missing-safe-haskell-mode++library+  import: deps+  hs-source-dirs:    src+  default-language:  Haskell2010+  exposed-modules:   Colog.Polysemy.Formatting+                     Colog.Polysemy.Formatting.Color+                     Colog.Polysemy.Formatting.LogEnv+                     Colog.Polysemy.Formatting.Render+                     Colog.Polysemy.Formatting.ThreadTimeMessage+                     Colog.Polysemy.Formatting.WithLog++executable example+  import:            deps+  main-is:           Main.hs+  hs-source-dirs:    example+  default-language:  Haskell2010+  ghc-options:       -threaded+                     -rtsopts+                     -with-rtsopts=-N+                     -fplugin=Polysemy.Plugin+  build-depends:       co-log-polysemy-formatting+                     , polysemy-plugin ^>= 0.2.4.0++source-repository head+  type:     git+  location: https://github.com/AJChapman/co-log-polysemy-formatting

@@ -0,0 +1,60 @@+-- Required for formatting+{-# LANGUAGE OverloadedStrings #-}++-- Required for Polysemy+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}++-- Required for co-log-polysemy-formatting.+-- This should re-export everything you need for logging.+import Colog.Polysemy.Formatting++-- Other imports for this example+import Data.Function ((&))+import Formatting+import Polysemy+import Polysemy.Async+import System.IO (stderr)++-- main needs the 'HasCallStack' constraint for log functions to know where they were called from+main :: HasCallStack => IO ()+main = do+  -- Set up a logging environment, logging to stderr and using the local timezone+  logEnvStderr <- newLogEnv stderr++  (do+    -- This debug message will show up only if 'debugMode' is True+    logDebug "MyApp version 0.1.0.0"++    -- Run our Polysemy program+    program+    )+      -- Set the level of logging we want (for more control see 'filterLogs')+      & setLogLevel Debug++      -- This lets us log the thread id and message timestamp with each log message+      & addThreadAndTimeToLog++      -- If you are using the 'Async' effect then interpret it here, after adding the thread and time,+      -- but before running the log action.+      & asyncToIO++      -- Log to stderr, using our logging environment+      & runLogAction (logTextStderr & cmap (renderThreadTimeMessage logEnvStderr))++      & runM++program :: (WithLog r, Members '[Async, Embed IO] r) => Sem r ()+program = do+  -- This concurrency is just here to demonstrate that it is possible.+  -- It isn't required.+  _ <- sequenceConcurrently $+    replicate 10 asyncProg+    <> [logError ("Error message: '" % accessed fst text <> "', number: " % accessed snd int) ("It's all broken!", 17 :: Int)]+    <> replicate 10 asyncProg+  pure ()+  where+    asyncProg = do+      logInfo "Hello, logging!"+      embed $ fprintLn "Hello, logging!"

binary file changed (absent → 190039 bytes)

@@ -0,0 +1,203 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+-- |+-- Module      : Colog.Polysemy.Formatting+-- Description : A Polysemy effect for logging using Co-Log.+--+-- Checklist for use:+--+--     1. Add `co-log-polysemy-formatting` to your `build-depends` in your .cabal file,+--     2. Turn on the OverloadedStrings language extension,+--     3. `import Colog.Polysemy.Formatting`+--     4. (optional) Add the 'HasCallStack' constrain to your `main` if it calls any logging functions directly,+--     5. Create a logging environment with 'newLogEnv', e.g. like this: @logEnvStderr <- newLogEnv stderr@+--     6. To create log messages from within the 'Sem' monad, add the @'WithLog' r@ constraint and then call any of the logging functions: 'logDebug', 'logInfo', 'logWarning', 'logError', or 'logException'.+--        Note that these take a "Formatting" formatter, not a String/Text/etc.+--        But note also that they can still take a string literal, which will be transformed into a formatter using OverloadedStrings.+--     7. (optional) When interpreting your program, add a call to 'filterLogs' to e.g. filter out Debug messages for a production build,+--     8. call 'addThreadAndTimeToLog',+--     9. call 'runLogAction', including a call to 'renderThreadTimeMessage' or 'Color.Polysemy.Formatting.Render.renderThreadTimeMessageShort' with the LogEnv you created in step 4, e.g. like this: @runLogAction (logTextStderr & cmap (renderThreadTimeMessage logEnvStderr))@.+--+-- Example of usage (this is a copy of example/Main.hs, which you can compile and run for yourself):+--+-- > -- Required for formatting+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > -- Required for Polysemy+-- > {-# LANGUAGE DataKinds #-}+-- > {-# LANGUAGE FlexibleContexts #-}+-- > {-# LANGUAGE GADTs #-}+-- >+-- > -- Required for co-log-polysemy-formatting.+-- > -- This should re-export everything you need for logging.+-- > import Colog.Polysemy.Formatting+-- >+-- > -- Other imports for this example+-- > import Data.Function ((&))+-- > import Formatting+-- > import Polysemy+-- > import Polysemy.Async+-- > import System.IO (stderr)+-- >+-- > -- main needs the 'HasCallStack' constraint for log functions to know where they were called from+-- > main :: HasCallStack => IO ()+-- > main = do+-- >   -- Set up a logging environment, logging to stderr and using the local timezone+-- >   logEnvStderr <- newLogEnv stderr+-- >+-- >   (do+-- >     -- This debug message will show up only if 'debugMode' is True+-- >     logDebug "MyApp version 0.1.0.0"+-- >+-- >     -- Run our Polysemy program+-- >     program+-- >     )+-- >       -- Set the level of logging we want (for more control see 'filterLogs')+-- >       & setLogLevel Debug+-- >+-- >       -- This lets us log the thread id and message timestamp with each log message+-- >       & addThreadAndTimeToLog+-- >+-- >       -- If you are using the 'Async' effect then interpret it here, after adding the thread and time,+-- >       -- but before running the log action.+-- >       & asyncToIO+-- >+-- >       -- Log to stderr, using our logging environment+-- >       & runLogAction (logTextStderr & cmap (renderThreadTimeMessage logEnvStderr))+-- >+-- >       & runM+-- >+-- > program :: (WithLog r, Members '[Async, Embed IO] r) => Sem r ()+-- > program = do+-- >   -- This concurrency is just here to demonstrate that it is possible.+-- >   -- It isn't required.+-- >   _ <- sequenceConcurrently $+-- >     replicate 10 asyncProg+-- >     <> [logError ("Error message: '" % accessed fst text <> "', number: " % accessed snd int) ("It's all broken!", 17 :: Int)]+-- >     <> replicate 10 asyncProg+-- >   pure ()+-- >   where+-- >     asyncProg = do+-- >       logInfo "Hello, logging!"+-- >       embed $ fprintLn "Hello, logging!"+--+-- The above produces this:+--+-- <<example/output.png example program output>>+module Colog.Polysemy.Formatting+  (+  -- * Creating log messages+    WithLog+  , WithLog'+  , logDebug+  , logInfo+  , logWarning+  , logError+  , logException++  -- * Interpreting the log+  , newLogEnv+  , ignoreLog+  , filterLogs+  , setLogLevel+  , addThreadAndTimeToLog+  , renderThreadTimeMessage++  -- * Re-exports from other packages+  , HasCallStack+  , runLogAction+  , logTextStdout+  , logTextStderr+  , logTextHandle+  , cmap+  , Severity(..)+  , Msg(..)+  ) where++import Prelude hiding (log)++import Colog (Msg(..), Severity(..), cmap)+import Colog.Actions (logTextHandle, logTextStderr, logTextStdout)+import Colog.Polysemy (Log(..), runLogAction)+import qualified Colog.Polysemy as Colog+import Control.Category ((>>>))+import Control.Exception (Exception, displayException)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import Formatting+import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)+import Polysemy++import Colog.Polysemy.Formatting.LogEnv (newLogEnv)+import Colog.Polysemy.Formatting.Render (renderThreadTimeMessage)+import Colog.Polysemy.Formatting.ThreadTimeMessage (addThreadAndTimeToLog, HasSeverity(..))+import Colog.Polysemy.Formatting.WithLog (WithLog, WithLog')++-- | Log a message with an explicit severity.+-- You probably don't want to use this directly.+-- Use 'logInfo', 'logError', etc. instead.+log :: WithLog r => Severity -> Format (Sem r ()) a -> a+log sev m = withFrozenCallStack $+  runFormat m+    $ Colog.log+    . Msg sev callStack+    . TL.toStrict+    . TLB.toLazyText++-- | Log a debug message in the given format.+logDebug :: WithLog r => Format (Sem r ()) a -> a+logDebug = withFrozenCallStack $ log Debug++-- | Log an info message in the given format.+logInfo :: WithLog r => Format (Sem r ()) a -> a+logInfo = withFrozenCallStack $ log Info++-- | Log a warning in the given format.+logWarning :: WithLog r => Format (Sem r ()) a -> a+logWarning = withFrozenCallStack $ log Warning++-- | Log an error in the given format.+logError :: WithLog r => Format (Sem r ()) a -> a+logError = withFrozenCallStack $ log Error++-- | Log the exception as an error.+logException :: (WithLog r, Exception e) => e -> Sem r ()+logException = withFrozenCallStack . logError string . displayException++-- | Interpret the 'Log' effect by completely ignoring all log messages.+ignoreLog :: Sem (Log msg ': r) a -> Sem r a+ignoreLog = interpret $ \case+  Log _ -> pure ()++-- | Remove any log messages that don't pass the given predicate.+--+-- E.g: @filterLogs ((<) Info . msgSeverity)@ will remove any logs that are 'Debug' or 'Info' severity, leaving only 'Warning's and 'Error's.+filterLogs+  :: Member (Log msg) r+  => (msg -> Bool)+  -> Sem (Log msg ': r) a+  -> Sem r a+filterLogs f = interpret $ \case+  Log msg -> if f msg+    then Colog.log msg+    else pure ()++-- | Only show logs that are this log level or higher (lower according to the Ord instance for 'Severity').+--+-- E.g: @setLogLevel Debug@ will show all logs, whereas+-- @setLogLevel Warning@ will show only warnings and errors.+setLogLevel+  :: ( HasSeverity msg+     , Member (Log msg) r+     )+  => Severity+  -> Sem (Log msg ': r) a+  -> Sem r a+setLogLevel level = filterLogs (getSeverity >>> (<=) level)

@@ -0,0 +1,45 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Colog.Polysemy.Formatting.Color+Description : Terminal colour support for log messages.+|-}+module Colog.Polysemy.Formatting.Color+  ( Color(..)+  , UseColor(..)+  , termColorSupport+  , getWithFG+  ) where++import qualified Data.Text.Lazy.Builder as TLB+import System.Console.ANSI+       ( Color(..)+       , ColorIntensity(Vivid)+       , ConsoleLayer(Foreground)+       , SGR(..)+       , hSupportsANSIColor+       , setSGRCode+       )+import System.IO (Handle)+import Formatting++-- | A 'Bool'-isomorphic type for expressing whether output should use color or not.+data UseColor = DoUseColor | DontUseColor++-- | Detect whether the terminal at the given handle (e.g. @stdout@) supports color output.+termColorSupport :: Handle -> IO UseColor+termColorSupport h =+  hSupportsANSIColor h >>= \case+    True -> pure DoUseColor+    False -> pure DontUseColor++-- | Generate a function for setting the foreground color.+getWithFG+  :: UseColor -- ^ Whether to actually use color, or ignore any given color.+  -> Color -- ^ The color to set the foreground text to+  -> TLB.Builder -> TLB.Builder+getWithFG DontUseColor _ txt = txt+getWithFG DoUseColor color txt =+  bformat (string % builder % string)+    (setSGRCode [SetColor Foreground Vivid color])+    txt+    (setSGRCode [Reset])

@@ -0,0 +1,27 @@+{-|+Module      : Colog.Polysemy.Formatting.LogEnv+Description : The 'LogEnv' datatype, to describe the logging environment.++|-}+module Colog.Polysemy.Formatting.LogEnv+  ( LogEnv(..)+  , newLogEnv+  ) where++import Data.Time (TimeZone, getCurrentTimeZone)+import System.IO (Handle)++import Colog.Polysemy.Formatting.Color (UseColor, termColorSupport)++-- | A datatype to contain the logging environment: whether to use color output (if supported by the terminal), and the timezone to stamp messages in.+data LogEnv = LogEnv UseColor TimeZone++-- | Create a 'LogEnv' suitable for the given handle.+-- If the output is an interactive terminal which supports color, then the output will be in color.+-- If not then the output will be plain text without color.+-- The timezone used will be that of the current machine.+newLogEnv :: Handle -> IO LogEnv+newLogEnv h = do+  zone <- getCurrentTimeZone+  useColor <- termColorSupport h+  pure $ LogEnv useColor zone

@@ -0,0 +1,153 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-|+Module      : Colog.Polysemy.Formatting.Render+Description : Render log messages.+|-}+module Colog.Polysemy.Formatting.Render+  ( renderThreadTimeMessage+  , renderThreadTimeMessageShort+  , fIso8601Tz+  , fSeverity+  , fThread+  , fCallerFromStack+  , fCaller+  , fCallerLong'+  , fCallerLong+  , fCallerShort'+  , fCallerShort+  ) where++import Colog (Msg(..), Severity(..))+import Control.Concurrent (ThreadId)+import Data.Char (isUpper)+import Data.Function ((&))+import qualified Data.Text as T+import Data.Text.Lazy.Builder (Builder)+import Data.Time (FormatTime, utcToZonedTime)+import Formatting+import Formatting.Time+import GHC.Stack (CallStack, SrcLoc(..), getCallStack)++import Colog.Polysemy.Formatting.Color (Color(..), UseColor, getWithFG)+import Colog.Polysemy.Formatting.LogEnv (LogEnv(..))+import Colog.Polysemy.Formatting.ThreadTimeMessage (ThreadTimeMessage(..))++-- | Render the message, optionally in color, with green " | " separating fields, and these fields:+--+--     * Severity (e.g. "INFO", see 'fSeverity'),+--     * Timestamp (e.g. "2020-10-13T16:58:43.982720690+1100", see 'fIso8601Tz'),+--     * Thread Id (e.g. "Thread     8", see 'fThread'),+--     * Caller (e.g. "MyApp.CLI.cliMain#43", see 'fCallerLong'), and+--     * The log message itself.+--+-- E.g: @"INFO | 2020-10-13T17:06:52.408921221+1100 | Thread     8 | MyApp.CLI.cliMain#43 | MyApp version 0.1.0.0"@+--+-- The first three columns are fixed-width, which makes visual scanning of the log easier.+renderThreadTimeMessage :: LogEnv -> ThreadTimeMessage -> T.Text+renderThreadTimeMessage = renderThreadTimeMessage' fCallerLong++-- | Like 'renderThreadTimeMessage', but abbreviate the caller by removing lowercase letters from the module name.+renderThreadTimeMessageShort :: LogEnv -> ThreadTimeMessage -> T.Text+renderThreadTimeMessageShort = renderThreadTimeMessage' fCallerShort++renderThreadTimeMessage' :: ((Color -> Builder -> Builder) -> Format Builder (CallStack -> Builder)) -> LogEnv -> ThreadTimeMessage -> T.Text+renderThreadTimeMessage' renderCaller (LogEnv useColor zone) (ThreadTimeMessage threadId time (Msg severity stack message)) =+  let withFG = getWithFG useColor+  in sformat (fFieldsGreenBarSep useColor)+    [ bformat (fSeverity withFG) severity+    , bformat (fIso8601Tz withFG) (utcToZonedTime zone time)+    , bformat fThread threadId+    , bformat (renderCaller withFG) stack+    , bformat stext message+    ]++fFieldsGreenBarSep :: UseColor -> Format r ([Builder] -> r)+fFieldsGreenBarSep useColor = later $ \fields ->+  let withFG = getWithFG useColor+      sep = format builder $ withFG Green " | "+  in bformat (intercalated sep builder) fields++-- | Render a timestamp in ISO-8601 format, in color, to 9 decimal places,+-- e.g.: "2020-10-13T16:58:43.982720690+1100"+--+-- The "T" is rendered in green, the time in yellow, the rest without color.+fIso8601Tz :: FormatTime a => (Color -> Builder -> Builder) -> Format r (a -> r)+fIso8601Tz withFG = later $ \time -> mconcat+  [ bformat dateDash time+  , withFG Green "T"+  , withFG Yellow $ bformat hmsL time+  , withFG Yellow $ bformat (right 10 '0') (bformat decimals time)+  , bformat tz time+  ]++-- | Render the 'Severity' of the message, with color, using 4 characters to maintain alignment:+--+--     * DBUG in green,+--     * INFO in blue,+--     * WARN in yellow, or+--     * ERR in red.+fSeverity :: (Color -> Builder -> Builder) -> Format r (Severity -> r)+fSeverity withFG = later $ \case+  Debug   -> withFG Green  "DBUG"+  Info    -> withFG Blue   "INFO"+  Warning -> withFG Yellow "WARN"+  Error   -> withFG Red    "ERR "++-- | Render the Id of the thread that the log message was generated in,+-- with a fixed width, at least until the thread Ids exceed 100,000,+-- e.g. "Thread    97".+fThread :: Format r (ThreadId -> r)+fThread = later $ \tid ->+  let s = show tid+  in bformat ("Thread " % left 5 ' ') (drop 9 s)++fCallerFromStack :: Format r (Maybe (String, SrcLoc) -> r) -> Format r (CallStack -> r)+fCallerFromStack = mapf callStackLoc+  where+    callStackLoc :: CallStack -> Maybe (String, SrcLoc)+    callStackLoc cs =+      case getCallStack cs of+        []                             -> Nothing+        [(name, loc)]                  -> Just (name, loc)+        (_, loc) : (callerName, _) : _ -> Just (callerName, loc)++fCaller :: (Color -> Builder -> Builder) -> Format r (String -> String -> Int -> r)+fCaller withFG =+  string % "." % colored Cyan string % "#" % colored Red int+  where+    colored c f = later $ \input ->+      bformat f input & withFG c++fCallerLong' :: (Color -> Builder -> Builder) -> Format r (Maybe (String, SrcLoc) -> r)+fCallerLong' withFG = maybed "<unknown loc>" $+  later $ \(name, SrcLoc{..}) ->+    bformat (fCaller withFG)+      srcLocModule+      name+      srcLocStartLine++-- | Render the fully qualified function that called the log function,+-- and line number in the source file, e.g. "MyApp.CLI.cliMain#43",+-- with the function name in cyan and line number in red.+fCallerLong :: (Color -> Builder -> Builder) -> Format r (CallStack -> r)+fCallerLong withFG = fCallerFromStack (fCallerLong' withFG)++fCallerShort' :: (Color -> Builder -> Builder) -> Format r (Maybe (String, SrcLoc) -> r)+fCallerShort' withFG = maybed "?" $+  later $ \(name, SrcLoc{..}) ->+    bformat (fCaller withFG)+      (abbreviateModule srcLocModule)+      name+      srcLocStartLine+  where+    abbreviateModule =+      filter (\c -> isUpper c || c == '.')++-- | Render the fully qualified function that called the log function,+-- and line number in the source file, abbreviating the module path by+-- removing lower-case letters, e.g. "MA.CLI.cliMain#43",+-- with the function name in cyan and line number in red.+fCallerShort :: (Color -> Builder -> Builder) -> Format r (CallStack -> r)+fCallerShort withFG = fCallerFromStack (fCallerShort' withFG)

@@ -0,0 +1,66 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-|+Module      : Colog.Polysemy.Formatting.ThreadTimeMessage+Description : A message type that includes ThreadId and a timestamp, wrapping a 'Message'.+|-}+module Colog.Polysemy.Formatting.ThreadTimeMessage+  ( ThreadTimeMessage(..)+  , HasSeverity(..)+  , ttmSeverity+  , addThreadAndTimeToLog+  ) where++import Prelude hiding (log)++import Colog (Message, Msg(..), Severity(..))+import Colog.Polysemy (Log(..), log)+import Control.Concurrent (ThreadId, myThreadId)+import Data.Time (UTCTime, getCurrentTime)+import Polysemy++-- | A log message which wraps a 'Message', adding a 'ThreadId' and 'UTCTime' timestamp.+data ThreadTimeMessage = ThreadTimeMessage+  { ttmThreadId :: ThreadId+  , ttmTime     :: UTCTime+  , ttmMsg      :: Message+  }++-- | Get the severity of the message.+ttmSeverity :: ThreadTimeMessage -> Severity+ttmSeverity = msgSeverity . ttmMsg++class HasSeverity msg where+  getSeverity :: msg -> Severity++instance HasSeverity (Msg Severity) where+  getSeverity = msgSeverity++instance HasSeverity ThreadTimeMessage where+  getSeverity = ttmSeverity++-- | Add the thread id and a timestamp to messages in the log.+-- This should be called /before/ any use of 'Polysemy.Async.asyncToIO', otherwise all log messages will have the same thread id.+-- It is best called /after/ any use of 'Colog.Polysemy.Formatting.filterLogs', otherwise you're needlessly processing messages that will never be logged (TODO: test this assertion is true).+addThreadAndTimeToLog+  :: Members+    '[ Embed IO+     , Log ThreadTimeMessage+     ] r+  => Sem (Log Message ': r) a+  -> Sem r a+addThreadAndTimeToLog = interpret $ \case+  Log msg -> do+    threadId <- embed myThreadId+    time <- embed getCurrentTime+    log $ ThreadTimeMessage threadId time msg++

@@ -0,0 +1,30 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-|+Module      : Colog.Polysemy.Formatting.WithLog+Description : A constraint for adding the logging effect.+|-}+module Colog.Polysemy.Formatting.WithLog+  ( WithLog'+  , WithLog+  ) where++import Colog (Msg(..), Severity(..))+import Colog.Polysemy (Log(..))+import GHC.Stack (HasCallStack)+import Polysemy++-- | This constraint allows you to specify a custom message type.+-- Otherwise, use 'WithLog' instead.+type WithLog' msg r = (HasCallStack, Member (Log msg) r)++-- | Add this constraint to a type signature to require+-- the 'Log' effect, with callstack support, using the 'Msg Severity' message type.+type WithLog r = WithLog' (Msg Severity) r++