packages feed

hslogger-colorfmt (empty) → 1.0.0

raw patch · 10 files changed

+421/−0 lines, 10 filesdep +ansi-terminaldep +basedep +hslogger

Dependencies added: ansi-terminal, base, hslogger, hslogger-colorfmt, time

Files

+ .gitignore view
@@ -0,0 +1,5 @@+# stack uses this directory for build artifacts+/.stack-work/++# Made by 'hasktags --ctags .'+tags
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+1.0.0 (2026-08-27)++  * Initial release
+ LICENSE view
@@ -0,0 +1,15 @@+Copyright (c) 2026, Dino Morelli <dino@ui3.info>++Permission to use, copy, modify, and/or distribute this software+for any purpose with or without fee is hereby granted, provided+that the above copyright notice and this permission notice appear+in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA+OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.
+ README.md view
@@ -0,0 +1,37 @@+# hslogger-colorfmt+++## Synopsis++Custom hslogger formatters implementing color output+++## Description++This library adds some custom log formatters implementing color output. We have+also added code to pad the Priority strings in log messages if desired.++Here's a screenshot of output from [some sample code](src/examples/Main.hs):++<img src='doc/hslogger-colorfmt_screenshot1.png' /><br>++For examining and choosing colors, there are many scripts out there for+displaying 256 color samples in terminals. Here's a particularly+[nice one](https://gist.github.com/HaleTom/89ffe32783f89f403bba96bd7bcd1263).+++## Getting source++Source code is available here: [hslogger-colorfmt](https://codeberg.org/dinofp/hslogger-colorfmt)++Handy command to generate Haddock docs during development if using stack. This+constrains doc generation to modules in the library:++    $ stack haddock --haddock --no-haddock-deps+++## Contact++Dino Morelli <dino@ui3.info>++[![Made by a human badge](doc/MadeByAHuman_01.png)](https://ko-fi.com/s/4662b19f61) This work is hand-crafted with no LLM/AI involved
+ hslogger-colorfmt.cabal view
@@ -0,0 +1,60 @@+cabal-version: 2.2++name: hslogger-colorfmt+version: 1.0.0+synopsis: Custom hslogger formatters implementing color output+description:+  This library adds some custom log formatters implementing color output. We+  have also added code to pad the Priority strings in log messages if desired.+author: Dino Morelli+maintainer: dino@ui3.info+copyright: 2026 Dino Morelli+category: Interfaces, Logging+license: ISC+license-file: LICENSE+build-type: Simple+extra-source-files:+  .gitignore+  README.md+  stack.yaml+extra-doc-files:+  CHANGELOG.md++source-repository head+  type: git+  location: https://codeberg.org/dinofp/hslogger-colorfmt++common lang+  default-language: Haskell2010+  ghc-options:+    -fwarn-tabs+    -Wall+    -Wcompat+    -Wderiving-typeable+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wpartial-fields+    -Wredundant-constraints+  build-depends:+      base >=3 && <5+    , hslogger >= 1.3.1.2 && < 2++library+  import: lang+  exposed-modules:+    System.Log.Color+    System.Log.Color.Formatter+    System.Log.Util+  hs-source-dirs:+    src/lib+  build-depends:+      ansi-terminal >= 1.1 && < 2+    , time >= 1.12.2 && < 2++executable hslogger-colorfmt-example+  import: lang+  main-is: Main.hs+  hs-source-dirs:+    src/examples+  build-depends:+      hslogger-colorfmt
+ src/examples/Main.hs view
@@ -0,0 +1,52 @@+import System.IO (stdout)++-- from hslogger+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple (streamHandler)+import System.Log.Logger++-- from hslogger-colorfmt+import System.Log.Color+import System.Log.Color.Formatter+import System.Log.Util+++n :: String+n = "mylogger"++msgFormat :: String+msgFormat = "$time $loggername $padPrio: $msg"+++initLogging :: String -> Maybe Priority -> IO ()+initLogging loggerName mLogPriority = do+  -- Removes the root logger's default handler that writes every+  -- message to stderr!+  updateGlobalLogger rootLoggerName removeHandler++  case mLogPriority of+    Nothing -> pure ()+    (Just logPriority) -> do+      updateGlobalLogger loggerName . addHandler+        . flip setFormatter (colorLogFormatter colors16 msgFormat)+          =<< streamHandler stdout DEBUG++      updateGlobalLogger loggerName $ setLevel logPriority+++main :: IO ()+main = do+  putStrLn "------------------------------------------"+  -- Example of completely turning off logging+  alertM n "This ALERT message is visible because of hslogger's default settings"+  alertM n "which is WARNING or higher and output to stderr."+  alertM n "We almost never want this. Getting rid of it:\n"+  putStrLn "    initLogging n Nothing\n"+  initLogging n Nothing+  emergencyM n "This message should never be shown"++  putStrLn "------------------------------------------"+  putStrLn "Example of color logging with padded Priority:\n"+  putStrLn "    initLogging n $ Just DEBUG\n"+  initLogging n $ Just DEBUG+  logTest n
+ src/lib/System/Log/Color.hs view
@@ -0,0 +1,92 @@+{-|+  Module containing color definitions, mappings between @Priority@ and color,+  and code to apply color to the terminal.+-}+module System.Log.Color+  ( ColorMap++  , colorize++  , black, red, green, yellow, blue, magenta, cyan, white+  , grey, bred, bgreen , byellow, bblue, bmagenta, bcyan, bwhite+  , colors16, colors256, noColor+  )+  where++import Data.List (find)+import Data.Word (Word8)+import System.Console.ANSI (ConsoleLayer (Foreground), SGR (..), setSGRCode)+import System.Log.Logger (Priority (..))+++colorize :: ColorMap -> Priority -> String -> String+colorize colorMap prio str = case priorityColor of+  (Just (swapColors, color)) ->+       setSGRCode [SetPaletteColor Foreground color]+    <> setSGRCode [SetSwapForegroundBackground swapColors]+    <> str+    <> setSGRCode [Reset]+  Nothing -> str++  where+    priorityColor = snd <$> find ((== prio) . fst) colorMap+++-- | These correspond to the basic 16 ANSI term color values+black, red, green, yellow, blue, magenta, cyan, white, grey, bred, bgreen,+  byellow, bblue, bmagenta, bcyan, bwhite :: Word8+black = 0+red = 1+green = 2+yellow = 3+blue = 4+magenta = 5+cyan = 6+white = 7+grey = 8+bred = 9+bgreen = 10+byellow = 11+bblue = 12+bmagenta = 13+bcyan = 14+bwhite = 15+++-- | This type maps a logging Priority to a pair indicating if the output+--   should be inverted (foreground and background swapped) and the color value+--   as a @Word8@ (an index into the 256 color palette)+type ColorMap = [(Priority, (Bool, Word8))]+++-- | Use this @ColorMap@ to disable color entirely+noColor :: ColorMap+noColor = []+++-- | Basic colors. Good when the term doesn't support 256.+colors16 :: ColorMap+colors16 =+  [ (DEBUG    , (False, bcyan))+  , (INFO     , (False, bgreen))+  , (NOTICE   , (False, bwhite))+  , (WARNING  , (False, byellow))+  , (ERROR    , (False, bred))+  , (CRITICAL , (False, magenta))+  , (ALERT    , (False, bblue))+  , (EMERGENCY, (True,  bred))+  ]+++-- | Some decent colors+colors256 :: ColorMap+colors256 =+  [ (DEBUG    , (False, 75))      -- Easier-to-read blue+  , (INFO     , (False, 156))     -- Minty green+  , (NOTICE   , (False, bwhite))  -- White+  , (WARNING  , (False, byellow)) -- Bright yellow+  , (ERROR    , (False, bred))    -- Bright red+  , (CRITICAL , (False, 161))     -- Dull red+  , (ALERT    , (False, 206))     -- Brighter magenta+  , (EMERGENCY, (True,  bred))    -- Inverted bright red+  ]
+ src/lib/System/Log/Color/Formatter.hs view
@@ -0,0 +1,70 @@+{-|+This module implements custom formatters, @colorLogFormatter@ and+@tfColorLogFormatter@, that behave much like @simpleLogFormatter@ and+@tfLogFormatter@ but optionally colors the messages and adds a+new field, @$padPrio@, to format all Priority values to the same width.++ * @$padPrio@ - The padded priority level of the message++The stock hslogger fields are also still available++ * @$msg@ - The actual log message+ * @$loggername@ - The name of the logger+ * @$prio@ - The priority level of the message+ * @$tid@ - The thread ID+ * @$pid@ - Process ID+ * @$time@ - The current local time+ * @$utcTime@ - The current UTC time++Note: I also took the liberty of changing the default date/time formatter to+@"%F %X %Z"@ which sorts nicely.+++Use this like you would any other @hslogger@ @Formatter@++  @setFormatter someHandler (colorLogFormatter colors16 "$time $loggername $padPrio: $msg")@+-}+module System.Log.Color.Formatter+  ( colorLogFormatter+  , tfColorLogFormatter+  )+  where++import Data.Time (formatTime, getCurrentTime, getZonedTime)+import Data.Time.Format (defaultTimeLocale)+import System.Log.Formatter (LogFormatter, varFormatter)+import System.Log.Logger (Priority (..))++import System.Log.Color (ColorMap, colorize)+++-- | This function behaves much like @simpleLogFormatter@ but optionally+--   colors the messages and adds a new field, @$padPrio@, to format all+--   Priority values to the same width.+colorLogFormatter :: ColorMap -> String -> LogFormatter a+colorLogFormatter colorMap msgFormat =+  tfColorLogFormatter colorMap msgFormat "%F %X %Z"+++-- | This function behaves much like @tfLogFormatter@ but optionally+--   colors the messages and adds a new field, @$padPrio@, to format all+--   Priority values to the same width.+tfColorLogFormatter :: ColorMap -> String -> String -> LogFormatter a+tfColorLogFormatter colorMap msgFormat timeFormat h (prio, msg) loggerName =+  colorize colorMap prio <$> varFormatter+    [ ("padPrio", pure $ showPadded prio)+    , ("time", formatTime defaultTimeLocale timeFormat <$> getZonedTime)+    , ("utcTime", formatTime defaultTimeLocale timeFormat <$> getCurrentTime)+    ]+    msgFormat h (prio, msg) loggerName+++showPadded :: Priority -> String+showPadded DEBUG     = "DEBUG    "+showPadded INFO      = "INFO     "+showPadded NOTICE    = "NOTICE   "+showPadded WARNING   = "WARNING  "+showPadded ERROR     = "ERROR    "+showPadded CRITICAL  = "CRITICAL "+showPadded ALERT     = "ALERT    "+showPadded EMERGENCY = "EMERGENCY"
+ src/lib/System/Log/Util.hs view
@@ -0,0 +1,19 @@+module System.Log.Util+  ( logTest+  )+  where++import System.Log.Logger+++-- | Test function to generate every kind of log message+logTest :: String -> IO ()+logTest loggerName = do+  debugM loggerName       "log test message DEBUG 1 of 8"+  infoM loggerName        "log test message INFO 2 of 8"+  noticeM loggerName      "log test message NOTICE 3 of 8"+  warningM loggerName     "log test message WARNING 4 of 8"+  errorM loggerName       "log test message ERROR 5 of 8"+  criticalM loggerName    "log test message CRITICAL 6 of 8"+  alertM loggerName       "log test message ALERT 7 of 8"+  emergencyM loggerName   "log test message EMERGENCY 8 of 8"
+ stack.yaml view
@@ -0,0 +1,68 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# https://docs.haskellstack.org/en/stable/configure/yaml/++# A 'specific' Stackage snapshot or a compiler version.+# A snapshot dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# snapshot: lts-24.24+# snapshot: nightly-2025-12-20+# snapshot: ghc-9.10.3+#+# The location of a snapshot can be provided as a file or url. Stack assumes+# a snapshot provided as a file might change, whereas a url resource does not.+#+# snapshot: ./custom-snapshot.yaml+# snapshot: https://example.com/snapshots/2024-01-01.yaml+# snapshot:+#   url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/36.yaml+snapshot: lts-24.11++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+#   subdirs:+#   - auto-update+#   - wai+packages:+- .+# Dependency packages to be pulled from upstream that are not in the snapshot.+# These entries can reference officially published versions as well as+# forks / in-progress versions pinned to a git hash. For example:+#+# extra-deps:+# - acme-missiles-0.3+# - git: https://github.com/commercialhaskell/stack.git+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#+# extra-deps: []++# Override default flag values for project packages and extra-deps+# flags: {}++# Extra package databases containing global packages+# extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of Stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=3.9"+#+# Override the architecture used by Stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by Stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor