diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,227 +1,153 @@
 # Flexible Logging with Monad-Effect
 
-`monad-effect-logging` is a flexible logging system utilizing the `monad-effect` effect system for Haskell, it gives you very fine control over the logging behavior.
-
-Main features include:
+`monad-effect-logging` is a pure structured logging library for the `monad-effect` ecosystem.
 
-* (Optional) Separation of log generation and rendering
+The current API is centered on one unified message payload `LogDoc`.
 
-* Pure logging
+## Highlights
 
-* Extensible log categories
+* You build one `LogDoc` value and decide at the boundary how to render it:
 
-* Compatible with `monad-logger`
+  - plain text
+  - ANSI colored text
+  - different `Show` strategies
+  - custom logger pipelines
+  
+* Color stays semantic until rendering time. A file logger can ignore color while a console logger can emit ANSI codes from the exact same log event.
 
-* `TraceId` support
+* Excellent `TraceId` support
 
-## Type Definition
+* Open log categories, extensible
 
-```haskell
-import qualified Control.Monad.Logger as ML
+* Easy JSON logging by tagging `loggerJson`
 
-data Logging m a
+This enables you to easily add JSON logging to your files while keeping the console output colorful and readable: you can write no-color json logging to a file while use `pSho` and color constructors to display stuff on the screen at the same time.
 
-instance Module (Logging m (a :: Type)) where
-  newtype ModuleRead  (Logging m a) = LoggingRead
-    { logging :: Logger m a
-    }
-  data    ModuleState (Logging m a) = LoggingState
+## Core types
 
-data Log a = Log
-  { _logType    :: [LogCat]
-  , _logContent :: a
-  } deriving (Functor)
+- `LogEvent` for the event envelope
+- `LogWithSourceMeta` for source-location metadata
+- `LogDoc` for the structured log message
+- `Logger` for the sink
+- `LogEffect` for the installed effect
 
-data LogMsg a = LogMsg
-  { _logLoc    :: Maybe ML.Loc
-  , _logSource :: Maybe ML.LogSource
-  , _logMsg    :: a
+```haskell
+data LogEvent a = LogEvent
+  { logEventCats :: [LogCat]
+  , logEventPayload :: a
   }
-```
 
-A `Logger m a` is just a function that takes a `Log a` and produces an effect in `m ()`.
+data LogWithSourceMeta a = LogWithSourceMeta
+  { logMetaLoc :: Maybe Loc
+  , logMetaSource :: Maybe LogSource
+  , logMetaDoc :: a
+  }
 
-```haskell
-type Logger :: (Type -> Type) -> Type -> Type
 newtype Logger m a = Logger
-  { _runLogger :: Log a -> m ()
+  { runLogger :: LogEvent a -> m ()
   }
-```
 
-## Features
+data LogEffect m a
 
-I developed it by using it and changing it to meet my needs. It solves the following problems:
+data LogDoc
+```
 
-### Separation Of Logs and Rendering
+The default installed logging effect is:
 
-Sometimes I want to write logs to different files, or sending logs to stdout and files at the same time. I wish I can use the `pretty-simple` pretty print with color in the terminal, but no color in the log files.
+```haskell
+type Logging = LogEffect IO LogDoc
+```
 
-This means we have to separate log generation and log rendering, we can do exactly that: we provide two default Loggings styles in `Module.Logging.LogS` which uses `Logger m (LogMsg LogStr)` and `Module.Logging.LogB` which uses `Logger m (LogMsg LogBuilder)` (allows you to separate log generation and rendering).
+## Building messages
 
-See `Module.Logging.LogB` for relevant functions and types. Here is an example:
+String literals work through `IsString`, and deferred values use `logShow`.
 
 ```haskell
-import Control.Monad.Effect
-import Module.RS
 import Module.Logging
-import Module.Logging.LogB
-import Module.Logging.Logger
-import Text.Pretty.Simple (pShow, pShowNoColor)
 
-runApp :: EffT '[RModule ProxyState, RModule ProxySettings, LoggingModuleB] NoError IO () -> IO ()
-runApp app = do
-  opts :: ProxyOptions Unwrapped <- unwrapRecord "Haskell Proxy Server" -- read command line options
-  case optionsToSettings opts of
-    Nothing -> putStrLn "Invalid options provided."
-    Just settings -> do
-      baseStdLogger <- useBaseLogger (logWithRendering (renderUsing (toLogStr . pShow)) . simpleLogger True)
-        <$> createSimpleConcurrentStdoutBaseLogger
-      baseFileLogger <- useBaseLogger (logWithRendering (renderUsing (toLogStr . pShowNoColor)) . simpleLogger True)
-        <$> createFileLogger "proxy.log"
-      let logger = baseStdLogger <> baseFileLogger :: LoggerWithCleanup IO LogB
-      runEffT00 $ withLoggerCleanup logger $ do
-        state <- initializeState settings
-        runRModule settings $ runRModule state app
-
-main :: IO ()
-main = runApp $ do
-  activeConnections <- liftIO $ newTVarIO M.empty
-  $(logTH Info) "Launching OwO"
-  settings <- askR @ProxySettings
-  $(logTH Info) $ "Options:" <> logShow settings
-  traceId <- liftIO $ newTVarIO (0 :: Word64)
-  -- | A Socket is a communication endpoint.
-  bracketEffT (liftIO $ socket AF_INET Stream defaultProtocol)
-    (\s -> do
-      liftIO $ close s
-      $(logTH Info) "Main Socket Closed."
-      threadIds <- liftIO $ M.elems <$> readTVarIO activeConnections
-      forM_ threadIds $ \t -> do
-        liftIO $ killThread t
-        $(logTH Info) $ "Killed thread: " <> logShow t
-    )
-    $ \sock -> do
-    -- ... Rest of the code
+example :: (Monad m, In (LogEffect m LogDoc) mods) => EffT mods es m ()
+example = do
+  $(logTH Info) $ "starting request " <> logShow (42 :: Int)
+  $(logTH Warn) $ logFg Yellow "slow query: " <> toLog ("SELECT ..." :: String)
 ```
 
-Those `logShow` does not immediately show anything, they are only rendered when the log is actually written to the output, using the specified rendering function.
-
-### Pure Logging
+Useful helpers:
 
-Logging typically works in `IO`, but sometimes I need a complex pure function state machine that outputs diagnostics. It would be great if I don't need to change anything inside the function, using the same logging utilities. The parametrized monad field of the logging effect allows you to use a pure monad (for example writer or state monads) to collect the logs, without needing to change anything inside the function (only need to change how you run it).
+- `logRaw`
+- `logShow`
+- `logFg`
+- `logBg`
+- `logBold`
+- `toLog`
 
-```haskell
-eventHandler
-  :: (Monad pureMonad)
-  => InputEvent
-  -> EffT
-      [ Logging pureMonad LogData -- ^ We will use logging to generate diagnostics
-      , EventState                -- ^ We need to read and update the state
-      ]
-      [ ErrorText "not-allowed"
-      ]
-      pureMonad
-      [OutputCommands]      -- ^ Output commands from the event module
-```
+Literal strings can be directly typed in using `IsString` class, no need to convert using helpers.
 
-### Extensible Log Categories
+## Rendering and base loggers
 
-You can easily define your own log categories, not just `Debug`, `Info`, `Warn`, `Error`. A log message can have multiple categories, you can add category at anytime using `effAddLogCat`, these types can be used to filter logs later.
+Most applications should use one options-based helper from `Module.Logging.Logger`:
 
 ```haskell
--- | An exsitential type that wraps all logging categories, it is easy to define a new instance
-data LogCat where
-  LogCat :: forall sub. IsLogCat sub => sub -> LogCat
+import Module.Logging
+import Module.Logging.Logger
 
--- | So every module can have its own logging category type, for example
--- Database module can have `data Database` used as a log type
---
--- and have a subtype
--- @
--- data DatabaseSubType = ConnectionPool | Query | Migration | Cursor deriving (Show, Eq)
--- @
---
--- you can then write instance
---
--- @
--- instance IsLogCat DatabaseSubType where
---   severity _    = Nothing
---   logTypeDisplay _ = "DB"
--- @
-class Typeable sub => IsLogCat (sub :: Type) where
-  severity :: sub -> Maybe LogSeverity
-  severity _ = Nothing
-  {-# INLINE severity #-}
-  -- | This is used for display only
-  logTypeDisplay :: sub -> ML.LogStr
-  {-# MINIMAL logTypeDisplay #-}
+runApp :: EffT '[LogEffect IO LogDoc] NoError IO () -> IO ()
+runApp app = do
+  stdoutBase <- createSimpleConcurrentStdoutBaseLogger
+  fileBase <- createFileLogger "app.log"
+
+  let stdoutLogger = makeLoggerFromBase ( buildLoggerStyle loggerUseAnsi                ) stdoutBase
+  let fileLogger   = makeLoggerFromBase ( buildLoggerStyle (loggerJson . loggerNoStyle) ) fileBase
+
+  runEffT00 $ withLoggerCleanup (stdoutLogger <> fileLogger) app
 ```
 
-Here is an example of defining your own log category `ProxyLog`:
+Here each style is a builder function `LoggerOptions -> LoggerOptions`, and the `buildLoggerStyle` function is just a composition of them on the `defaultLoggerStyle`.
 
-```haskell
-import Module.Logging as L
-import Language.Haskell.TH.Syntax (Lift)
+For custom pipelines, use the lower-level building blocks:
 
-data ProxyLog = Bytes | Logic deriving (Show, Eq, Lift)
-instance IsLogCat ProxyLog where
-  severity Bytes = severity L.Debug
-  severity Logic = severity L.Info
-  logTypeDisplay Bytes = "BYTES"
-  logTypeDisplay Logic = "LOGIC"
+- `renderLogEvent`
+- `loggerFromRenderer`
+- your own `Logger`
+
+Styles compose as normal functions:
+
+```haskell
+verboseConsole :: LoggerOptions
+verboseConsole =
+  buildLoggerStyle
+    $ loggerUseAnsi
+    . loggerOrder [LogTimeChunk, LogCatChunk, LogLocChunk, LogDocChunk]
 ```
 
-The `Lift` class is only necessary if you want to use them inside `logTH` template haskell utilities, otherwise you can remove it.
+## Categories
 
-To use them, using functions in `Module.Logging.LogS` or `Module.Logging.LogB`, under corresponding logging context:
+Categories are open and extensible:
 
 ```haskell
-import Module.Logging
-import Module.Logging.LogS
+data ProxyLog = Bytes | Logic deriving (Lift)
+-- The `Lift` class is only necessary if you want to use them inside `logTH` template haskell
+-- utilities, otherwise you can remove it.
 
-example :: (In (Logging m LogS) mods, Monad m) => EffT mods es m ()
-example = do
-  sendBytesToClient 1024
-  $(logTH Bytes) "Sent 1024 bytes to client"
-  processUserLogin
-  $(logTH Logic) "User logged in successfully"
+instance IsLogCat ProxyLog where
+  severity Bytes = severity Debug
+  severity Logic = severity Info
+  logTypeName Bytes = "BYTES"
+  logTypeName Logic = "LOGIC"
 ```
 
-### Compatible With `monad-logger`
+You can add local categories with `effAddLogCat`, and filter them with the existing combinators.
 
-You can use all utilities from `monad-logger` inside the `Logging m LogS` effect here since we implement the `MonadLogger` and `MonadLoggerIO` class for it. Although we recommend using the logging utilities provided in `Module.Logging.LogS` and `Module.Logging.LogB`.
+## `MonadLogger` compatibility
 
-```haskell
-botInstanceToModule :: BotInstance -> EffT '[LoggingModule] NoError IO BotModules
-botInstanceToModule bot@(BotInstance runFlag identityFlags commandFlags mode proxyFlags logFlags watchDogFlags _) = do
-    $(logInfo) $ "\n### Starting bot instance: " <> tshow bot
-    $(logInfo) $ "Running mode: "   <> tshow mode
-    $(logInfo) $ "Running flags: "  <> tshow runFlag
-    $(logInfo) $ "Identity flags: " <> tshow identityFlags
-    $(logInfo) $ "Command flags: "  <> tshow commandFlags
-    $(logInfo) $ "Proxy flags: "    <> tshow proxyFlags
-    $(logInfo) $ "Log flags: "      <> tshow logFlags
-    $(logInfo) $ "WatchDog flags: " <> tshow watchDogFlags
-    let mGlobalSysMsg = listToMaybe [ pack sysMsg | UseSysMsg sysMsg <- identityFlags ]
-        withDefault def [] = def
-        withDefault _ xs = xs
-        botModules = BotModules
-          { canUseGroupCommands   = withDefault (identifier <$> allGroupCommands)   (coerce commandFlags)
-          , canUsePrivateCommands = withDefault (identifier <$> allPrivateCommands) (coerce commandFlags)
-          , nameOfBot = BotName $ listToMaybe [ nameBot | UseName nameBot <- identityFlags ]
-          , botId = fromMaybe 0 $ listToMaybe [ idBot | UseId idBot <- identityFlags ]
-          , globalSysMsg = mGlobalSysMsg
-          , proxyTChans = []
-          , logFile = [ logFile | LogFlag logFile <- logFlags ]
-          , botInstance = bot
-          }
-    return botModules
-```
+`MonadLogger` and `MonadLoggerIO` are implemented for `LogEffect m LogDoc`.
 
-### `TraceId` Support
+Incoming `monad-logger` messages are wrapped as `logRaw`, so compatibility fits directly into the unified payload model.
 
-In complex applications, it is often useful to trace the flow of a request or operation across multiple log entries. Use `withTraceId` to attach a `TraceId` to a block of codes, all logger inside that block will automatically include the `TraceId` in their log categories.
+## `TraceId`
 
-We also included some optional trace id generation utilities.
+This library also provides a super convenient `TraceId` mechanism that can attach scoped trace IDs to log events.
+`TraceId` is just a log category. Use `withTraceId` or one of the provided generators from `Module.Logging.TraceId`.
 
-See `Module.Logging.TraceId` for relevant functions and types.
+## Status
+
+This release presents the library around `LogDoc`, options-based logger construction, open categories, and boundary-driven rendering.
diff --git a/monad-effect-logging.cabal b/monad-effect-logging.cabal
--- a/monad-effect-logging.cabal
+++ b/monad-effect-logging.cabal
@@ -9,7 +9,7 @@
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version:            0.1.0.0
+version:            0.3.0.0
 
 -- A short (one-line) description of the package.
 synopsis: A flexible logging system utilizing the `monad-effect` effect system.
@@ -54,8 +54,6 @@
 
     -- Modules exported by the library.
     exposed-modules: Module.Logging
-                   , Module.Logging.LogS
-                   , Module.Logging.LogB
                    , Module.Logging.Logger
                    , Module.Logging.TraceId
     ghc-options: -fexpose-all-unfoldings
@@ -79,6 +77,7 @@
                  , template-haskell >= 2.20 && < 2.24
                  , primitive < 0.10
                  , clock < 0.9
+                 , optparse-applicative < 0.20
 
     -- Directories containing source files.
     hs-source-dirs:   src
@@ -94,3 +93,4 @@
                       , LambdaCase
                       , TypeFamilies
                       , TypeApplications
+                      , TypeAbstractions
diff --git a/src/Module/Logging.hs b/src/Module/Logging.hs
--- a/src/Module/Logging.hs
+++ b/src/Module/Logging.hs
@@ -1,33 +1,59 @@
-{-# LANGUAGE TemplateHaskell, UndecidableInstances, AllowAmbiguousTypes, DeriveLift, OverloadedRecordDot #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeAbstractions #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
--- | We want a logger that supports open categories, open levels, open severities etc.
--- so that we can filter on different levels for different categories
---
--- finally we will also provide an interface for MonadLogger for compatibility
+
 module Module.Logging
-  ( -- * Definitions
+  ( -- * Core Types
     LogSeverity
   , IsLogCat(..)
   , LogCat(..)
-  , Log(..), logType, logContent
-  , LogMsg(..), logLoc, logSource, logMsg
-  , Logger(..), runLogger
+  , someSeverity
+  , someLogCatName
+  , someLogCatDisplay
+    -- * Log Event Model
+  , LogEvent(..)
+  , logEventCats
+  , logEventPayload
+  , LogWithSourceMeta(..)
+  , logMetaLoc
+  , logMetaSource
+  , logMetaDoc
+  , Logger(..)
+  , runLogger
+  , LogEffect
   , Logging
   , LoggingModule
-  -- * Default log categories
+    -- * Structured Log Documents
+  , LogDoc
+  , SomeShown
+  , NamedColor(..)
+  , Color(..)
+  , Style(..)
+  , defaultStyle
+  , StyleMode(..)
+  , DocRenderOptions(..)
+  , defaultDocRenderOptions
+  , renderLogDoc
+  , logRaw
+  , logShow
+  , logFg
+  , logBg
+  , logBold
+  , ToLog(..)
+    -- * Default Log Categories
   , Debug(..)
   , Info(..)
   , Warn(..)
   , Error(..)
   , Other(..)
-  -- * Default log implementation
-  , toLogStrS
-  , logLog
-  , LogS
-  , LogData
-  -- * Combinators
+    -- * Logger Combinators
   , localLogger
-  , localLog
+  , localLogEvent
   , addLogCat
   , effAddLogCat
   , effAddLogCat'
@@ -39,402 +65,627 @@
   , isLogCat
   , isLogSubType
   , isLogCatName
-  , someSeverity
-  , someLogCatName
-  -- * Running and initializing
-  , runLogging
+  , liftLogger
+    -- * Logging Operations
+  , emitLogEvent
+  , log_
+  , logLoc_
+  , logs
+  , logTH
+  , logLocIO
+  , logIO
+  , logsIO
+  , logTHIO
+    -- * Running and Initialization
+  , runLogEffect
   , withLiftLogger
-  -- * Other optional utilities
   , defaultStringToLogSeverity
-  , defaultLoggingFromEnv
-  , defaultLoggingFromArgs
+    -- * Compatibility
   , monadLoggerAdapter
   , mlLogLevelToLogCat
-
-  -- * Re-export
+    -- * Re-exports
   , ModuleRead(..)
   , ModuleState(..)
   , ModuleInitData(..)
   , ModuleEvent(..)
-  -- * Re-export contravariant functors
   , module Data.Functor.Contravariant
   ) where
 
 import Control.Applicative
 import Control.Lens
-import Control.System
 import Control.Monad
 import Control.Monad.Effect
-import Control.Monad.Logger (Loc(..))
+import Control.System
 import Data.Fixed
 import Data.Functor.Contravariant
 import Data.Kind
+import Data.List (intercalate)
 import Data.Maybe
+import Data.String (IsString(..))
 import Data.Text (Text)
 import Data.Typeable
-import qualified Control.Monad.Logger as ML
-
-import System.Environment
+import Data.Word
 import Text.Read (readMaybe)
-
+import qualified Control.Monad.Logger as ML
+import qualified Language.Haskell.TH as TH
 import qualified Language.Haskell.TH.Syntax as TH
 
--- | so user can interpolate between levels easily
---
--- by default, Debug = 1, Info = 2, Warn = 3, Error = 4
--- you can use anything in between, with a precision of 1 decimal place
--- for example, 2.5 is between Info and Warn
 type LogSeverity = Fixed E1
 
--- | So every module can have its own logging category type, for example
--- Database module can have `data Database` used as a log type
---
--- and have a subtype
--- @
--- data DatabaseSubType = ConnectionPool | Query | Migration | Cursor deriving (Show, Eq)
--- @
---
--- you can then write instance
---
--- @
--- instance IsLogCat DatabaseSubType where
---   severity _    = Nothing
---   logTypeDisplay _ = "DB"
--- @
-class Typeable sub => IsLogCat (sub :: Type) where
-  severity :: sub -> Maybe LogSeverity
+class Typeable cat => IsLogCat (cat :: Type) where
+  severity :: cat -> Maybe LogSeverity
   severity _ = Nothing
-  {-# INLINE severity #-}
-  -- | This is used for display only
-  logTypeDisplay :: sub -> ML.LogStr
-  {-# MINIMAL logTypeDisplay #-}
 
-instance IsLogCat Text where
-  logTypeDisplay = ML.toLogStr
+  logTypeName :: cat -> ML.LogStr
+  {-# MINIMAL logTypeName #-}
+
+  logTypeDisplay :: ML.LogStr -> LogDoc
+  logTypeDisplay = DocRaw
   {-# INLINE logTypeDisplay #-}
 
--- | An exsitential type that wraps all logging categories, it is easy to define a new instance
+instance IsLogCat Text where
+  logTypeName = ML.toLogStr
+
 data LogCat where
-  LogCat :: forall sub. IsLogCat sub => sub -> LogCat
+  LogCat :: forall cat. IsLogCat cat => cat -> LogCat
 
 someSeverity :: LogCat -> Maybe LogSeverity
-someSeverity (LogCat @a subType) = severity @a subType
-{-# INLINE someSeverity #-}
+someSeverity (LogCat @cat x) = severity @cat x
 
 someLogCatName :: LogCat -> ML.LogStr
-someLogCatName (LogCat @a subType) = logTypeDisplay @a subType
-{-# INLINE someLogCatName #-}
+someLogCatName (LogCat @cat x) = logTypeName @cat x
 
-data Log a = Log
-  { _logType    :: [LogCat]
-  , _logContent :: a
-  } deriving (Functor)
+someLogCatDisplay :: LogCat -> LogDoc
+someLogCatDisplay (LogCat @cat x) = logTypeDisplay @cat (logTypeName @cat x)
 
-type LogS = LogMsg ML.LogStr
+-- | Carries several log categories and a payload.
+data LogEvent a = LogEvent
+  { _logEventCats    :: [LogCat]
+  , _logEventPayload :: a
+  }
+  deriving (Functor)
 
-type LogData = LogS
-{-# DEPRECATED LogData "Use LogS instead" #-}
+data LogWithSourceMeta a = LogWithSourceMeta
+  { _logMetaLoc    :: Maybe ML.Loc
+  , _logMetaSource :: Maybe ML.LogSource
+  , _logMetaDoc    :: a
+  }
+  deriving (Functor)
 
-data LogMsg a = LogMsg
-  { _logLoc    :: Maybe ML.Loc
-  , _logSource :: Maybe ML.LogSource
-  , _logMsg    :: a
+data SomeShown where
+  SomeShown :: Show a => a -> SomeShown
+
+data NamedColor
+  = Black
+  | Red
+  | Green
+  | Yellow
+  | Blue
+  | Magenta
+  | Cyan
+  | White
+  deriving (Eq, Show)
+
+data Color
+  = DefaultColor
+  | Named !NamedColor
+  | RGB   !Word8 !Word8 !Word8
+  deriving (Eq, Show)
+
+class IsLogColor c where
+  toLogColor :: c -> Color
+
+instance IsLogColor Color where
+  toLogColor = id
+
+instance IsLogColor NamedColor where
+  toLogColor = Named
+
+instance IsLogColor (Word8, Word8, Word8) where
+  toLogColor (r, g, b) = RGB r g b
+
+class ToLog a where
+  toLog :: a -> LogDoc
+
+instance ToLog LogDoc where
+  toLog = id
+
+instance ToLog Text where
+  toLog = DocRaw . ML.toLogStr
+
+instance ToLog String where
+  toLog = DocRaw . ML.toLogStr
+
+data Style = Style
+  { styleFg   :: Maybe Color
+  , styleBg   :: Maybe Color
+  , styleBold :: Bool
   }
+  deriving (Eq, Show)
 
-makeLenses ''Log
-makeLenses ''LogMsg
-makeLenses ''Loc
+defaultStyle :: Style
+defaultStyle =
+  Style
+    { styleFg   = Nothing
+    , styleBg   = Nothing
+    , styleBold = False
+    }
 
-instance Functor LogMsg where
-  fmap f logMsg' = logMsg' { _logMsg = f (_logMsg logMsg') }
-  {-# INLINE fmap #-}
+data LogDoc
+  = DocEmpty
+  | DocRaw    ML.LogStr
+  | DocShown  SomeShown
+  | DocStyled Style  LogDoc
+  | DocAppend LogDoc LogDoc
 
-instance Semigroup a => Semigroup (LogMsg a) where
-  l1 <> l2 = LogMsg
-    { _logLoc = l1 ^. logLoc <|> l2 ^. logLoc
-    , _logSource = l1 ^. logSource <|> l2 ^. logSource
-    , _logMsg = l1 ^. logMsg <> l2 ^. logMsg
+data StyleMode
+  = NoStyles
+  | AnsiStyles
+  deriving (Eq, Show)
+
+data DocRenderOptions = DocRenderOptions
+  { docRenderShow      :: forall a. Show a => a -> ML.LogStr
+  , docRenderStyleMode :: StyleMode
+  }
+
+defaultDocRenderOptions :: DocRenderOptions
+defaultDocRenderOptions =
+  DocRenderOptions
+    { docRenderShow      = ML.toLogStr . show
+    , docRenderStyleMode = NoStyles
     }
-  {-# INLINE (<>) #-}
 
-instance Monoid a => Monoid (LogMsg a) where
-  mempty = LogMsg Nothing Nothing mempty
-  {-# INLINE mempty #-}
+makeLenses ''LogEvent
+makeLenses ''LogWithSourceMeta
 
--- | Some default log types, you can easily define your own
-data    Debug = Debug  deriving TH.Lift
-data    Info  = Info   deriving TH.Lift
-data    Warn  = Warn   deriving TH.Lift
-data    Error = Error  deriving TH.Lift
-newtype Other = Other Text  deriving TH.Lift
+instance Semigroup a => Semigroup (LogEvent a) where
+  LogEvent catsA payloadA <> LogEvent catsB payloadB =
+    LogEvent (catsA <> catsB) (payloadA <> payloadB)
 
-instance IsLogCat Debug where severity _ = Just 1; logTypeDisplay _ = "DEBUG"
-instance IsLogCat Info  where severity _ = Just 2; logTypeDisplay _ = "INFO"
-instance IsLogCat Warn  where severity _ = Just 3; logTypeDisplay _ = "WARN"
-instance IsLogCat Error where severity _ = Just 4; logTypeDisplay _ = "ERROR"
-instance IsLogCat Other where
-  severity _ = Just 2
-  logTypeDisplay (Other t) = "OTHER:" <> ML.toLogStr t
+instance Monoid a => Monoid (LogEvent a) where
+  mempty = LogEvent [] mempty
 
-instance Semigroup a => Semigroup (Log a) where
-  Log t1 c1 <> Log t2 c2 = Log (t1 <> t2) (c1 <> c2)
-  {-# INLINE (<>) #-}
+instance Applicative LogEvent where
+  pure = LogEvent []
+  LogEvent catsF f <*> LogEvent catsA a = LogEvent (catsF <> catsA) (f a)
 
-instance Monoid a => Monoid (Log a) where
-  mempty = Log [] mempty
-  {-# INLINE mempty #-}
+instance Monad LogEvent where
+  LogEvent catsA a >>= f =
+    let LogEvent catsB b = f a
+     in LogEvent (catsA <> catsB) b
 
-instance Applicative Log where
-  pure = Log []
-  {-# INLINE pure #-}
-  Log t1 f <*> Log t2 a = Log (t1 <> t2) (f a)
-  {-# INLINE (<*>) #-}
+instance Semigroup a => Semigroup (LogWithSourceMeta a) where
+  metaA <> metaB =
+    LogWithSourceMeta
+      { _logMetaLoc    = _logMetaLoc    metaA <|> _logMetaLoc    metaB
+      , _logMetaSource = _logMetaSource metaA <|> _logMetaSource metaB
+      , _logMetaDoc    = _logMetaDoc    metaA <>  _logMetaDoc    metaB
+      }
 
-instance Monad Log where
-  (Log t a) >>= f =
-    let Log t' a' = f a
-    in Log (t <> t') a'
-  {-# INLINE (>>=) #-}
+instance Monoid a => Monoid (LogWithSourceMeta a) where
+  mempty = LogWithSourceMeta Nothing Nothing mempty
 
+instance IsString LogDoc where
+  fromString = DocRaw . ML.toLogStr
+
+instance Semigroup LogDoc where
+  (<>) = DocAppend
+
+instance Monoid LogDoc where
+  mempty = DocEmpty
+
+data Debug    = Debug      deriving TH.Lift
+data Info     = Info       deriving TH.Lift
+data Warn     = Warn       deriving TH.Lift
+data Error    = Error      deriving TH.Lift
+newtype Other = Other Text deriving TH.Lift
+
+instance IsLogCat Debug where
+  severity _ = Just 1
+  logTypeName _ = "DEBUG"
+  logTypeDisplay = logFg Blue . DocRaw
+
+instance IsLogCat Info where
+  severity _ = Just 2
+  logTypeName _ = "INFO"
+  logTypeDisplay = logFg Green . DocRaw
+
+instance IsLogCat Warn where
+  severity _ = Just 3
+  logTypeName _ = "WARN"
+  logTypeDisplay = logFg Yellow . DocRaw
+
+instance IsLogCat Error where
+  severity _ = Just 4
+  logTypeName _ = "ERROR"
+  logTypeDisplay = logFg Red . DocRaw
+
+instance IsLogCat Other where
+  severity _ = Just 2
+  logTypeName (Other t) = "OTHER:" <> ML.toLogStr t
+
 type Logger :: (Type -> Type) -> Type -> Type
 newtype Logger m a = Logger
-  { _runLogger :: Log a -> m ()
+  { _runLogger :: LogEvent a -> m ()
   }
 
-liftLogger :: (m () -> n ()) -> Logger m b -> Logger n b
-liftLogger f (Logger g) = Logger (f . g)
-{-# INLINE liftLogger #-}
+runLogger :: Logger m a -> LogEvent a -> m ()
+runLogger = _runLogger
 
-makeLenses ''Logger
+liftLogger :: (m () -> n ()) -> Logger m a -> Logger n a
+liftLogger nat (Logger f) = Logger (nat . f)
 
 instance Applicative m => Semigroup (Logger m a) where
-  Logger f <> Logger g = Logger $ \log' -> f log' *> g log'
-  {-# INLINE (<>) #-}
+  Logger f <> Logger g = Logger $ \entry -> f entry *> g entry
 
 instance Applicative m => Monoid (Logger m a) where
   mempty = Logger $ const $ pure ()
-  {-# INLINE mempty #-}
 
 instance Contravariant (Logger m) where
   contramap f (Logger g) = Logger (g . fmap f)
-  {-# INLINE contramap #-}
 
---------------------------------------------------------------------------------
--- $ Some combinators for logger filtering
---
--- You can use these combinators to filter logs based on their types and severities.
--- Example:
---
--- @
--- localLogger
---   ( anyLogCat (severityThat $ Predicate (>= 1))
---   . excludeLogCat (isLogCat @Database)
---   ) $ do
---     ...
--- @
+logRaw :: ML.LogStr -> LogDoc
+logRaw = DocRaw
 
--- | Locally modify the logger
-localLogger :: forall a c m mods es b. (Monad m, In' c (Logging m a) mods) => (Logger m a -> Logger m a) -> EffT' c mods es m b -> EffT' c mods es m b
-localLogger f = localModule (\(LoggingRead logger) -> LoggingRead (f logger))
-{-# INLINE localLogger #-}
+logShow :: Show a => a -> LogDoc
+logShow = DocShown . SomeShown
 
--- | Locally modify the log
-localLog :: forall a m mods es c. (Monad m, Logging m a `In` mods) => (Log a -> Log a) -> EffT mods es m c -> EffT mods es m c
-localLog f = localLogger $ over runLogger (. f)
-{-# INLINE localLog #-}
+logFg :: IsLogColor color => color -> LogDoc -> LogDoc
+logFg color = DocStyled defaultStyle {styleFg = Just $ toLogColor color}
 
--- | Add a log category to the log
--- @
--- localLogger (addLogCat $ LogCat ConnectionPool) $ do
---   ...
--- @
+logBg :: IsLogColor color => color -> LogDoc -> LogDoc
+logBg color = DocStyled defaultStyle {styleBg = Just $ toLogColor color}
+
+logBold :: LogDoc -> LogDoc
+logBold = DocStyled defaultStyle {styleBold = True}
+
+renderLogDoc :: DocRenderOptions -> LogDoc -> ML.LogStr
+renderLogDoc opts = case docRenderStyleMode opts of
+  NoStyles -> goPlain
+  AnsiStyles -> goAnsi defaultStyle
+  where
+    goPlain DocEmpty                 = mempty
+    goPlain (DocRaw str)             = str
+    goPlain (DocShown (SomeShown x)) = docRenderShow opts x
+    goPlain (DocStyled _ doc)        = goPlain doc
+    goPlain (DocAppend a b)          = goPlain a <> goPlain b
+
+    goAnsi _       DocEmpty                 = mempty
+    goAnsi _       (DocRaw str)             = str
+    goAnsi _       (DocShown (SomeShown x)) = docRenderShow opts x
+    goAnsi current (DocAppend a b)          = goAnsi current a <> goAnsi current b
+    goAnsi current (DocStyled style doc)    =
+      let merged = mergeStyle current style
+       in ansiForStyle merged <> goAnsi merged doc <> ansiForStyle current
+
+mergeStyle :: Style -> Style -> Style
+mergeStyle outer inner =
+  Style
+    { styleFg   = styleFg   inner <|> styleFg   outer
+    , styleBg   = styleBg   inner <|> styleBg   outer
+    , styleBold = styleBold outer ||  styleBold inner
+    }
+
+ansiForStyle :: Style -> ML.LogStr
+ansiForStyle style =
+  ML.toLogStr $ "\ESC[" <> mconcat (intercalate [";"] (pure <$> codes)) <> "m"
+  where
+    codes =
+      let baseCodes =
+            concat
+              [ maybe [] colorToFgCodes (styleFg style)
+              , maybe [] colorToBgCodes (styleBg style)
+              , ["1" | styleBold style]
+              ]
+       in if null baseCodes then ["0"] else baseCodes
+
+colorToFgCodes :: Color -> [ML.LogStr]
+colorToFgCodes DefaultColor  = ["39"]
+colorToFgCodes (Named color) = [lshow $ namedColorCode color]
+colorToFgCodes (RGB r g b)   = ["38", "2", lshow r, lshow g, lshow b]
+
+colorToBgCodes :: Color -> [ML.LogStr]
+colorToBgCodes DefaultColor  = ["49"]
+colorToBgCodes (Named color) = [lshow $ namedColorCode color + 10]
+colorToBgCodes (RGB r g b)   = ["48", "2", lshow r, lshow g, lshow b]
+
+lshow :: Show a => a -> ML.LogStr
+lshow = ML.toLogStr . show
+{-# INLINE lshow #-}
+
+namedColorCode :: NamedColor -> Int
+namedColorCode = \case
+  Black   -> 30
+  Red     -> 31
+  Green   -> 32
+  Yellow  -> 33
+  Blue    -> 34
+  Magenta -> 35
+  Cyan    -> 36
+  White   -> 37
+
+localLogger
+  :: forall a c m mods es b.
+     (Monad m, In' c (LogEffect m a) mods)
+  => (Logger m (LogWithSourceMeta a) -> Logger m (LogWithSourceMeta a))
+  -> EffT' c mods es m b
+  -> EffT' c mods es m b
+localLogger f =
+  localModule (\(LogEffectRead logger) -> LogEffectRead (f logger))
+
+localLogEvent
+  :: forall a m mods es c.
+     (Monad m, LogEffect m a `In` mods)
+  => (LogEvent (LogWithSourceMeta a) -> LogEvent (LogWithSourceMeta a))
+  -> EffT mods es m c
+  -> EffT mods es m c
+localLogEvent f = localLogger $ \(Logger g) -> Logger (g . f)
+
 addLogCat :: LogCat -> Logger m a -> Logger m a
-addLogCat t = over runLogger (. over logType (t:))
-{-# INLINE addLogCat #-}
+addLogCat cat (Logger g) =
+  Logger $ \entry -> g entry {_logEventCats = cat : _logEventCats entry}
 
--- | Add a log category to the log in EffT
--- @
--- effAddLogCat @LogS (LogCat ConnectionPool) $ do
---   ...
--- @
-effAddLogCat :: forall a c mods es m b. (Monad m, In' c (Logging m a) mods) => LogCat -> EffT' c mods es m b -> EffT' c mods es m b
-effAddLogCat logCat = localLogger @a (addLogCat logCat)
-{-# INLINE effAddLogCat #-}
+effAddLogCat
+  :: forall a c mods es m b.
+     (Monad m, In' c (LogEffect m a) mods)
+  => LogCat
+  -> EffT' c mods es m b
+  -> EffT' c mods es m b
+effAddLogCat cat = localLogger @a (addLogCat cat)
 
--- | Add a log category to the log in EffT (defaulting to In (Logging m LogS) mods)
--- @
--- effAddLogCat' (LogCat ConnectionPool) $ do
---   ...
--- @
-effAddLogCat' :: forall c mods es m b. (Monad m, In' c (Logging m LogS) mods) => LogCat -> EffT' c mods es m b -> EffT' c mods es m b
-effAddLogCat' logCat = localLogger @LogS (addLogCat logCat)
-{-# INLINE effAddLogCat' #-}
+effAddLogCat'
+  :: forall c mods es m b.
+     (Monad m, In' c (LogEffect m LogDoc) mods)
+  => LogCat
+  -> EffT' c mods es m b
+  -> EffT' c mods es m b
+effAddLogCat' = effAddLogCat @LogDoc
 
 filterLogCats :: Applicative m => Predicate [LogCat] -> Logger m a -> Logger m a
-filterLogCats p (Logger logger) = Logger $ \log' -> when (p.getPredicate $ log' ^. logType) $ logger log'
-{-# INLINE filterLogCats #-}
+filterLogCats p (Logger logger) =
+  Logger $ \entry ->
+    when (getPredicate p $ _logEventCats entry) $
+      logger entry
 
 anyLogCat :: Applicative m => Predicate LogCat -> Logger m a -> Logger m a
-anyLogCat p = filterLogCats (Predicate $ any p.getPredicate)
-{-# INLINE anyLogCat #-}
+anyLogCat p = filterLogCats (Predicate $ any (getPredicate p))
 
 excludeLogCat :: Applicative m => Predicate LogCat -> Logger m a -> Logger m a
-excludeLogCat p = filterLogCats (Predicate $ not . any p.getPredicate)
-{-# INLINE excludeLogCat #-}
+excludeLogCat p = filterLogCats (Predicate $ not . any (getPredicate p))
 
 severityThat :: Predicate LogSeverity -> Predicate LogCat
 severityThat = contramap (fromMaybe 0 . someSeverity)
-{-# INLINE severityThat #-}
 
 noSeverity :: Predicate LogCat
 noSeverity = Predicate (isNothing . someSeverity)
-{-# INLINE noSeverity #-}
 
--- | use type applications to check if a log type is present
-isLogCat :: forall sub. IsLogCat sub => Predicate LogCat
-isLogCat = Predicate $ \(LogCat (_ :: sub')) -> case eqT @sub @sub' of
-  Just Refl -> True
-  Nothing   -> False
-{-# INLINE isLogCat #-}
+-- | Use with type applications
+isLogCat :: forall cat. IsLogCat cat => Predicate LogCat
+isLogCat =
+  Predicate $ \(LogCat (_ :: cat')) -> case eqT @cat @cat' of
+    Just Refl -> True
+    Nothing -> False
 
-isLogSubType :: forall sub. IsLogCat sub => Predicate sub -> Predicate LogCat
-isLogSubType p = Predicate $ \(LogCat (subType :: sub')) -> case eqT @sub @sub' of
-  Just Refl -> p.getPredicate subType
-  Nothing   -> False
-{-# INLINE isLogSubType #-}
+isLogSubType :: forall cat. IsLogCat cat => Predicate cat -> Predicate LogCat
+isLogSubType p =
+  Predicate $ \(LogCat (x :: cat')) -> case eqT @cat @cat' of
+    Just Refl -> getPredicate p x
+    Nothing -> False
 
 isLogCatName :: ML.ToLogStr n => n -> Predicate LogCat
-isLogCatName name = Predicate $ \logCat -> someLogCatName logCat == ML.toLogStr name
-{-# INLINE isLogCatName #-}
+isLogCatName name =
+  Predicate $ \logCat -> someLogCatName logCat == ML.toLogStr name
 
--- | The Logging m module type, a module `Logging m a` provides logging capabilities for logs of type `a`
-type Logging :: (Type -> Type) -> Type -> Type
-data Logging m a
+type LogEffect :: (Type -> Type) -> Type -> Type
+data LogEffect m a
 
-type LoggingModule = Logging IO LogS -- standard logging module
+type Logging = LogEffect
 
+type LoggingModule = LogEffect IO LogDoc
+
 withLiftLogger
   :: forall m n c a mods es b.
-  ( Monad m
-  , In' c (Logging m a) (Logging m a : mods)
-  , ConsFDataList c (Logging n a : mods)
-  , ConsFDataList c (Logging m a : mods)
-  )
-  => (forall x. m x -> n x) -> EffT' c (Logging n a : mods) es m b -> EffT' c (Logging m a : mods) es m b
+     ( Monad m
+     , In' c (LogEffect m a) (LogEffect m a : mods)
+     , ConsFDataList c (LogEffect n a : mods)
+     , ConsFDataList c (LogEffect m a : mods)
+     )
+  => (forall x. m x -> n x)
+  -> EffT' c (LogEffect n a : mods) es m b
+  -> EffT' c (LogEffect m a : mods) es m b
 withLiftLogger lifter act = do
-  LoggingRead logger <- askModule @(Logging m a)
-  let logger' = liftLogger lifter logger
-  embedMods $ runEffTOuter_ (LoggingRead logger') LoggingState act
+  LogEffectRead logger <- askModule @(LogEffect m a)
+  embedMods $ runEffTOuter_ (LogEffectRead $ liftLogger lifter logger) LogEffectState act
 
-instance Module (Logging m (a :: Type)) where
-  newtype ModuleRead  (Logging m a) = LoggingRead
-    { logging :: Logger m a
+instance Module (LogEffect m a) where
+  newtype ModuleRead (LogEffect m a) = LogEffectRead
+    { logging :: Logger m (LogWithSourceMeta a)
     }
-  data    ModuleState (Logging m a) = LoggingState
+  data ModuleState (LogEffect m a) = LogEffectState
 
-runLogging
-  :: (ConsFDataList c (Logging m logS : mods), Monad m) => Logger m logS
-  -> EffT' c (Logging m logS : mods) es m a
-  -> EffT' c mods es m a
-runLogging logger = runEffTOuter_ (LoggingRead logger) LoggingState
-{-# INLINE runLogging #-}
+runLogEffect
+  :: (ConsFDataList c (LogEffect m a : mods), Monad m)
+  => Logger m (LogWithSourceMeta a)
+  -> EffT' c (LogEffect m a : mods) es m b
+  -> EffT' c mods es m b
+runLogEffect logger = runEffTOuter_ (LogEffectRead logger) LogEffectState
 
-instance SystemModule (Logging m a) where
-  data    ModuleInitData (Logging m a) = LoggingInitData
-    { loggerInitLogger   :: Logger IO a
-    , loggerInitSeverity :: Maybe LogSeverity
-    , loggerInitCleanup  :: Maybe (IO ())
+instance SystemModule (LogEffect m a) where
+  data ModuleInitData (LogEffect m a) = LogEffectInitData
+    { loggerInitBase       :: Logger m (LogWithSourceMeta a)
+    , loggerInitCleanup    :: Maybe (m ())
+    , loggerInitTransform  :: Logger m (LogWithSourceMeta a) -> Logger m (LogWithSourceMeta a)
+    , loggerInitSeverity   :: Maybe LogSeverity
     }
-  data    ModuleEvent    (Logging m a) = LoggingEvent
+  data ModuleEvent (LogEffect m a) = LogEffectEvent
 
-instance Loadable c (Logging IO a) mods ies where
-  withModule (LoggingInitData logger mSev Nothing) act = case mSev of
-    Nothing -> runEffTOuter_ (LoggingRead logger) LoggingState act
-    Just s -> runEffTOuter_ (LoggingRead $ anyLogCat (severityThat $ Predicate (>= s)) logger) LoggingState act
-  withModule (LoggingInitData logger mSev (Just clean)) act = bracketEffT (return ()) (\_ -> liftIO clean) (\_ -> case mSev of
-      Nothing -> runEffTOuter_ (LoggingRead logger) LoggingState act
-      Just s -> runEffTOuter_ (LoggingRead $ anyLogCat (severityThat $ Predicate (>= s)) logger) LoggingState act
-    )
-  {-# INLINE withModule #-}
+instance Loadable c (LogEffect IO a) mods ies where
+  withModule initData act =
+    let transformedLogger = loggerInitTransform initData (loggerInitBase initData)
+        baseLogger = case loggerInitSeverity initData of
+          Nothing -> transformedLogger
+          Just sev ->
+            anyLogCat (severityThat $ Predicate (>= sev)) transformedLogger
+        runAction = runEffTOuter_ (LogEffectRead baseLogger) LogEffectState act
+     in case loggerInitCleanup initData of
+          Nothing -> runAction
+          Just cleanup -> bracketEffT (pure ()) (\_ -> liftIO cleanup) (const runAction)
 
-instance EventLoop c (Logging m a) mods es
+instance EventLoop c (LogEffect m a) mods es
 
--- | Maps 'Debug', 'Info', 'Warn', 'Error' to 1, 2, 3, 4 respectively
--- and also accepts numbers between 0 and 10 with a precision of 1 decimal place
+emitLogEvent
+  :: forall a c mods es m.
+     (Monad m, In' c (LogEffect m a) mods)
+  => LogEvent (LogWithSourceMeta a)
+  -> EffT' c mods es m ()
+emitLogEvent entry = do
+  action <- asksModule @(LogEffect m a) (runLogger . logging)
+  lift $ action entry
+
+logLoc_
+  :: forall c mods es m cat.
+     (Monad m, In' c (LogEffect m LogDoc) mods, IsLogCat cat)
+  => ML.Loc
+  -> cat
+  -> LogDoc
+  -> EffT' c mods es m ()
+logLoc_ loc cat doc =
+  emitLogEvent $
+    LogEvent
+      { _logEventCats = [LogCat cat]
+      , _logEventPayload =
+          LogWithSourceMeta
+            { _logMetaLoc    = Just loc
+            , _logMetaSource = Nothing
+            , _logMetaDoc    = doc
+            }
+      }
+
+log_
+  :: forall c mods es m cat.
+     (Monad m, In' c (LogEffect m LogDoc) mods, IsLogCat cat)
+  => cat
+  -> LogDoc
+  -> EffT' c mods es m ()
+log_ cat doc =
+  emitLogEvent $
+    LogEvent
+      { _logEventCats = [LogCat cat]
+      , _logEventPayload =
+          LogWithSourceMeta
+            { _logMetaLoc    = Nothing
+            , _logMetaSource = Nothing
+            , _logMetaDoc    = doc
+            }
+      }
+
+logs
+  :: forall c mods es m.
+     (Monad m, In' c (LogEffect m LogDoc) mods)
+  => [LogCat]
+  -> LogDoc
+  -> EffT' c mods es m ()
+logs cats doc =
+  emitLogEvent $
+    LogEvent
+      { _logEventCats = cats
+      , _logEventPayload =
+          LogWithSourceMeta
+            { _logMetaLoc    = Nothing
+            , _logMetaSource = Nothing
+            , _logMetaDoc    = doc
+            }
+      }
+
+logTH :: (IsLogCat cat, TH.Lift cat) => cat -> TH.Q TH.Exp
+logTH cat = [| logLoc_ $(TH.qLocation >>= TH.lift) $(TH.lift cat) |]
+
+logLocIO
+  :: forall c mods es m cat.
+     (MonadIO m, In' c (LogEffect IO LogDoc) mods, IsLogCat cat)
+  => ML.Loc
+  -> cat
+  -> LogDoc
+  -> EffT' c mods es m ()
+logLocIO loc cat = baseTransform liftIO . logLoc_ loc cat
+
+logIO
+  :: forall c mods es m cat.
+     (MonadIO m, In' c (LogEffect IO LogDoc) mods, IsLogCat cat)
+  => cat
+  -> LogDoc
+  -> EffT' c mods es m ()
+logIO cat = baseTransform liftIO . log_ cat
+
+logsIO
+  :: forall c mods es m.
+     (MonadIO m, In' c (LogEffect IO LogDoc) mods)
+  => [LogCat]
+  -> LogDoc
+  -> EffT' c mods es m ()
+logsIO cats = baseTransform liftIO . logs cats
+
+logTHIO :: (IsLogCat cat, TH.Lift cat) => cat -> TH.Q TH.Exp
+logTHIO cat = [| baseTransform liftIO . logLoc_ @LogDoc $(TH.qLocation >>= TH.lift) $(TH.lift cat) |]
+
 defaultStringToLogSeverity :: String -> Either Text LogSeverity
 defaultStringToLogSeverity = \case
   "Debug" -> Right 1
   "Info"  -> Right 2
   "Warn"  -> Right 3
   "Error" -> Right 4
-  other   -> maybe (Left "Invalid LogLevel, must be one of 'Debug', 'Info', 'Warn', 'Error', or a number between 0 and 10 with a precision of 1 decimal place") Right
-    $ readMaybe other
-{-# INLINABLE defaultStringToLogSeverity #-}
-
--- | Load a log level from environment variable LOG_LEVEL,
-defaultLoggingFromEnv :: Logger IO LogS -> Maybe (IO ()) -> IO (ModuleInitData LoggingModule)
-defaultLoggingFromEnv logger mcl = do
-  mLogLevel <- liftIO $ (readMaybe =<<) <$> lookupEnv "LOG_LEVEL"
-  return $ LoggingInitData logger mLogLevel mcl
-{-# INLINABLE defaultLoggingFromEnv #-}
-
--- | Load an argument --log-level <level> from command line arguments,
--- if none is provided, it will log everything (Maybe LogSeverity = Nothing)
-defaultLoggingFromArgs :: Logger IO LogS -> Maybe (IO ()) -> [String] -> Either Text (ModuleInitData LoggingModule)
-defaultLoggingFromArgs logger mcl []         = Right $ LoggingInitData logger Nothing mcl
-defaultLoggingFromArgs logger mcl args@(_:_) = do
-  level    <- maybe (Right Nothing) (fmap Just) $ detectFlag "--log-level" defaultStringToLogSeverity args
-  types    <- sequence $ detectAllFlags "--log-type"    (\case "" -> Left "Empty log type"; s -> Right s) args
-  nonTypes <- sequence $ detectAllFlags "--no-log-type" (\case "" -> Left "Empty log type"; s -> Right s) args
-  let logger' = foldr ($) logger (  [ anyLogCat     (isLogCatName name) | name <- types ]
-                                 <> [ excludeLogCat (isLogCatName name) | name <- nonTypes ]
-                                 )
-  return $ LoggingInitData logger' level mcl
-{-# INLINABLE defaultLoggingFromArgs #-}
+  other ->
+    maybe
+      (Left "Invalid LogLevel, must be one of 'Debug', 'Info', 'Warn', 'Error', or a number between 0 and 10 with a precision of 1 decimal place")
+      Right
+      (readMaybe other)
 
-monadLoggerAdapter :: Logger m LogS -> ML.Loc -> ML.LogSource -> ML.LogLevel -> ML.LogStr -> m ()
-monadLoggerAdapter logger loc src lev msg = _runLogger logger Log
-  { _logType = [mlLogLevelToLogCat lev]
-  , _logContent = LogMsg
-      { _logLoc    = Just loc
-      , _logSource = Just src
-      , _logMsg    = msg
+monadLoggerAdapter
+  :: Logger m (LogWithSourceMeta LogDoc)
+  -> ML.Loc
+  -> ML.LogSource
+  -> ML.LogLevel
+  -> ML.LogStr
+  -> m ()
+monadLoggerAdapter logger loc src lev msg =
+  runLogger logger $
+    LogEvent
+      { _logEventCats = [mlLogLevelToLogCat lev]
+      , _logEventPayload =
+          LogWithSourceMeta
+            { _logMetaLoc    = Just loc
+            , _logMetaSource = Just src
+            , _logMetaDoc    = logRaw msg
+            }
       }
-  }
-{-# INLINE monadLoggerAdapter #-}
 
--- | This provides an interface to MonadLogger
-instance (Monad m, In' c (Logging m LogS) mods) => ML.MonadLogger (EffT' c mods es m) where
-  monadLoggerLog loc logsource loglevel msg = do
-    LoggingRead logger <- queryModule @(Logging m LogS)
-    lift $ monadLoggerAdapter logger loc logsource loglevel (ML.toLogStr msg)
-  {-# INLINE monadLoggerLog #-}
+instance (Monad m, In' c (LogEffect m LogDoc) mods) => ML.MonadLogger (EffT' c mods es m) where
+  monadLoggerLog loc src lev msg = do
+    LogEffectRead logger <- queryModule @(LogEffect m LogDoc)
+    lift $ monadLoggerAdapter logger loc src lev (ML.toLogStr msg)
 
-instance (m ~ IO, In' c (Logging m LogS) mods) => ML.MonadLoggerIO (EffT' c mods es m) where
-  askLoggerIO = queriesModule @(Logging m LogS) $ (\f loc src lev str -> f
-    $ Log [mlLogLevelToLogCat lev]
-    $ LogMsg
-      { _logLoc    = Just loc
-      , _logSource = Just src
-      , _logMsg    = str
-      }
-    ) . _runLogger . logging
-  {-# INLINE askLoggerIO #-}
+instance (m ~ IO, In' c (LogEffect m LogDoc) mods) => ML.MonadLoggerIO (EffT' c mods es m) where
+  askLoggerIO =
+    queriesModule @(LogEffect m LogDoc) $
+      (\f loc src lev str ->
+         f $
+           LogEvent
+             { _logEventCats = [mlLogLevelToLogCat lev]
+             , _logEventPayload =
+                 LogWithSourceMeta
+                   { _logMetaLoc    = Just loc
+                   , _logMetaSource = Just src
+                   , _logMetaDoc    = logRaw str
+                   }
+             }
+      )
+        . runLogger
+        . logging
 
--- | A compatibility function that works for the old MonadLogger instances
 mlLogLevelToLogCat :: ML.LogLevel -> LogCat
-mlLogLevelToLogCat ML.LevelDebug     = LogCat Debug
-mlLogLevelToLogCat ML.LevelInfo      = LogCat Info
-mlLogLevelToLogCat ML.LevelWarn      = LogCat Warn
-mlLogLevelToLogCat ML.LevelError     = LogCat Error
-mlLogLevelToLogCat (ML.LevelOther t) = LogCat (Other t)
-{-# INLINE mlLogLevelToLogCat #-}
-
-logLog :: forall a c mods es m. (Monad m, In' c (Logging m a) mods) => Log a -> EffT' c mods es m ()
-logLog logd = asksModule @(Logging m a) (_runLogger . logging) >>= (\action -> lift $ action logd)
-{-# INLINABLE logLog #-}
-
--- | Apply 'show' to convert a value to LogStr
-toLogStrS :: Show a => a -> ML.LogStr
-toLogStrS = ML.toLogStr . show
-{-# INLINE toLogStrS #-}
+mlLogLevelToLogCat = \case
+  ML.LevelDebug   -> LogCat Debug
+  ML.LevelInfo    -> LogCat Info
+  ML.LevelWarn    -> LogCat Warn
+  ML.LevelError   -> LogCat Error
+  ML.LevelOther t -> LogCat (Other t)
diff --git a/src/Module/Logging/LogB.hs b/src/Module/Logging/LogB.hs
deleted file mode 100644
--- a/src/Module/Logging/LogB.hs
+++ /dev/null
@@ -1,114 +0,0 @@
--- | Module      : Module.Logging.LogVal
---   Description : Log value builders and renderers. This module provides a way to build log messages separately from rendering them, allowing for flexible logging rendering strategies (e.g. with console colors, JSON formatting, etc.).
-{-# LANGUAGE TemplateHaskell #-}
-module Module.Logging.LogB
-  ( -- * Log value builders and renderers
-    LogVals
-  , LogBuilder
-  , LogRenderer
-  , toLog
-  , logShow
-  , renderUsing
-
-  -- * Logging module types
-  , LogB
-  , LoggingModuleB
-  -- * General logging utilities
-  , log_
-  , logLoc_
-  , logs
-  , logTH
-  -- * MonadIO specific versions
-  , logLocIO
-  , logIO
-  , logsIO
-  , logTHIO
-  ) where
-
-import Data.String (IsString(..))
-import qualified Control.Monad.Logger as ML
-import qualified Language.Haskell.TH as TH
-import qualified Language.Haskell.TH.Syntax as TH
-import Module.Logging
-import Control.Monad.Effect
-import Control.Lens
-
--- | Note on LogStr from monad-logger:
---   It is just Data.ByteString.Builder.Builder, but with extra length information for buffering.
-data LogVal where
-  LogValStr :: ML.LogStr   -> LogVal
-  LogShow   :: Show a => a -> LogVal
-
-type LogVals = [LogVal]
-
-type LogBuilder   = LogVals    -> LogVals
-type LogRenderer  = LogBuilder -> ML.LogStr
-
-instance IsString LogVal where
-  fromString = LogValStr . fromString
-  {-# INLINE fromString #-}
-
-instance IsString LogBuilder where
-  fromString s = (LogValStr (fromString s) :)
-  {-# INLINE fromString #-}
-instance {-# OVERLAPPING #-} Semigroup LogBuilder where
-  (<>) = (.)
-  {-# INLINE (<>) #-}
-instance {-# OVERLAPPING #-} Monoid LogBuilder where
-  mempty = id
-  {-# INLINE mempty #-}
-
--- | Use this function together with OverloadedStrings and <> to log your messages
-logShow :: Show a => a -> LogBuilder
-logShow v = (LogShow v :)
-{-# INLINE logShow #-}
-
-renderUsing :: (forall a. Show a => a -> ML.LogStr) -> LogRenderer
-renderUsing func vals = mconcat @ML.LogStr $ map renderVal (vals [])
-  where renderVal (LogValStr ls) = ls
-        renderVal (LogShow   v ) = func v
-
-type LogB = LogMsg LogBuilder
-
-type LoggingModuleB = Logging IO LogB
-
-toLog :: (ML.ToLogStr a) => a -> LogBuilder
-toLog = (:) . LogValStr . ML.toLogStr
-{-# INLINE toLog #-}
-
-logLoc_ :: (Monad m, In' c (Logging m LogB) mods, IsLogCat subType) => ML.Loc -> subType -> LogBuilder -> EffT' c mods es m ()
-logLoc_ src subTypeType msg = logLog (Log [LogCat subTypeType] (mempty @LogB & logMsg .~ msg & logLoc ?~ src))
-{-# INLINE logLoc_ #-}
-
--- | Simple logging function, provide one log type and a LogStr message
-log_ :: (Monad m, In' c (Logging m LogB) mods, IsLogCat subType) => subType -> LogBuilder -> EffT' c mods es m ()
-log_ subTypeType msg = logLog (Log [LogCat subTypeType] (mempty @LogB & logMsg .~ msg))
-{-# INLINE log_ #-}
-
--- | Log with multiple log types (wrapped in existantial constructor LogCat)
-logs :: (Monad m, In' c (Logging m LogB) mods) => [LogCat] -> LogBuilder -> EffT' c mods es m ()
-logs logTypes msg = logLog (Log logTypes (mempty @LogB & logMsg .~ msg))
-{-# INLINE logs #-}
-
--- | Template Haskell helper with location info
-logTH :: (IsLogCat subType, TH.Lift subType) => subType -> TH.Q TH.Exp
-logTH subType = [| logLoc_ $(TH.qLocation >>= TH.lift) $(TH.lift subType) |]
-
----------- Monad IO specific versions ----------
-
- -- | Useful when you are in a MonadIO but with a Logging IO _ type module
-logLocIO :: (MonadIO m, In' c (Logging IO LogB) mods, IsLogCat subType) => ML.Loc -> subType -> LogBuilder -> EffT' c mods es m ()
-logLocIO src subTypeType = baseTransform liftIO . logLoc_ src subTypeType
-{-# INLINE logLocIO #-}
-
-logIO :: (MonadIO m, In' c (Logging IO LogB) mods, IsLogCat subType) => subType -> LogBuilder -> EffT' c mods es m ()
-logIO subTypeType = baseTransform liftIO . log_ subTypeType
-{-# INLINE logIO #-}
-
-logsIO :: (MonadIO m, In' c (Logging IO LogB) mods) => [LogCat] -> LogBuilder -> EffT' c mods es m ()
-logsIO logTypes = baseTransform liftIO . logs logTypes
-{-# INLINE logsIO #-}
-
--- | Template Haskell helper with location info, with m=IO
-logTHIO :: (IsLogCat subType, TH.Lift subType) => subType -> TH.Q TH.Exp
-logTHIO subType = [| baseTransform liftIO . logLoc_ $(TH.qLocation >>= TH.lift) $(TH.lift subType) |]
diff --git a/src/Module/Logging/LogS.hs b/src/Module/Logging/LogS.hs
deleted file mode 100644
--- a/src/Module/Logging/LogS.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Module.Logging.LogS
-  (
-  -- * Log value builders and renderers
-    toLog
-  , logShow
-  -- * Logging module types
-  , LogS
-  , LoggingModule
-  -- * General logging utilities
-  , log_
-  , logLoc_
-  , logs
-  , logTH
-  , logS
-  -- * MonadIO specific versions
-  , logLocIO
-  , logIO
-  , logsIO
-  , logTHIO
-  -- * Re-export
-  , ML.LogStr
-  ) where
-
-import qualified Control.Monad.Logger as ML
-import qualified Language.Haskell.TH as TH
-import qualified Language.Haskell.TH.Syntax as TH
-import Module.Logging
-import Control.Monad.Effect
-import Control.Lens
-
-toLog :: (ML.ToLogStr a) => a -> ML.LogStr
-toLog = ML.toLogStr
-{-# INLINE toLog #-}
-
-logShow :: Show a => a -> ML.LogStr
-logShow = ML.toLogStr . show
-{-# INLINE logShow #-}
-
-logS :: (Monad m, In' c (Logging m LogS) mods) => LogS -> EffT' c mods es m ()
-logS logd = logLog (Log [] logd)
-{-# INLINE logS #-}
-
-logLoc_ :: (Monad m, In' c (Logging m LogS) mods, IsLogCat subType) => ML.Loc -> subType -> ML.LogStr -> EffT' c mods es m ()
-logLoc_ src subTypeType msg = logLog (Log [LogCat subTypeType] (mempty @LogS & logMsg .~ msg & logLoc ?~ src))
-{-# INLINE logLoc_ #-}
-
--- | Simple logging function, provide one log type and a LogStr message
-log_ :: (Monad m, In' c (Logging m LogS) mods, IsLogCat subType) => subType -> ML.LogStr -> EffT' c mods es m ()
-log_ subTypeType msg = logLog (Log [LogCat subTypeType] (mempty @LogS & logMsg .~ msg))
-{-# INLINE log_ #-}
-
--- | Log with multiple log types (wrapped in existantial constructor LogCat)
-logs :: (Monad m, In' c (Logging m LogS) mods) => [LogCat] -> ML.LogStr -> EffT' c mods es m ()
-logs logTypes msg = logLog (Log logTypes (mempty @LogS & logMsg .~ msg))
-{-# INLINE logs #-}
-
--- | Template Haskell helper with location info
-logTH :: (IsLogCat subType, TH.Lift subType) => subType -> TH.Q TH.Exp
-logTH subType = [| logLoc_ $(TH.qLocation >>= TH.lift) $(TH.lift subType) |]
-
----------- Monad IO specific versions ----------
-
-logLocIO :: (MonadIO m, In' c (Logging IO LogS) mods, IsLogCat subType) => ML.Loc -> subType -> ML.LogStr -> EffT' c mods es m ()
-logLocIO src subTypeType = baseTransform liftIO . logLoc_ src subTypeType
-{-# INLINE logLocIO #-}
-
-logIO :: (MonadIO m, In' c (Logging IO LogS) mods, IsLogCat subType) => subType -> ML.LogStr -> EffT' c mods es m ()
-logIO subTypeType = baseTransform liftIO . log_ subTypeType
-{-# INLINE logIO #-}
-
-logsIO :: (MonadIO m, In' c (Logging IO LogS) mods) => [LogCat] -> ML.LogStr -> EffT' c mods es m ()
-logsIO logTypes = baseTransform liftIO . logs logTypes
-{-# INLINE logsIO #-}
-
--- | Template Haskell helper with location info, with MonadIO
-logTHIO :: (IsLogCat subType, TH.Lift subType) => subType -> TH.Q TH.Exp
-logTHIO subType = [| baseTransform liftIO . logLoc_ @IO $(TH.qLocation >>= TH.lift) $(TH.lift subType) |]
diff --git a/src/Module/Logging/Logger.hs b/src/Module/Logging/Logger.hs
--- a/src/Module/Logging/Logger.hs
+++ b/src/Module/Logging/Logger.hs
@@ -1,200 +1,439 @@
-{-# LANGUAGE RecordWildCards, DuplicateRecordFields #-}
--- | Some simple combinators to build your logger
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ApplicativeDo         #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
+
 module Module.Logging.Logger
-  ( module Module.Logging.Logger
-  -- * Re-exporting fast-logger
+  ( -- * Logger Lifecycle
+    LoggerWithCleanup(..)
+  , liftBaseLogger
+    -- * Logger Options
+  , LoggerOptions(..)
+  , LogOrderControl(..)
+  , LoggerStyle
+  , defaultLoggerStyle
+  , buildLoggerStyle
+  , loggerUseAnsi
+  , loggerNoStyle
+  , loggerShowWith
+  , loggerNoTime
+  , loggerNoCats
+  , loggerNoLoc
+  , loggerNoSource
+  , loggerNoNewline
+  , loggerJson
+  , loggerOrder
+    -- * Base Loggers
+  , createFastBaseLogger
+  , createStdoutBaseLogger
+  , createSimpleStdoutBaseLogger
+  , createSimpleConcurrentStdoutBaseLogger
+  , createStderrBaseLogger
+  , createFileLogger
+  , createFileLoggerWith
+    -- * Rendering and Composition
+  , renderLogEvent
+  , loggerFromRenderer
+  , makeLoggerFromBase
+  , withLoggerCleanup
+  , withBaseLogger
+  , withBaseLoggerIO
+    -- * Helpers
+  , defaultLoggingFromEnv
+  , defaultLoggingFromArgs
+  , defaultLoggingOptParser
+    -- * Re-exporting fast-logger
   , module System.Log.FastLogger
   ) where
 
-import Control.Monad
 import Control.Concurrent
 import Control.Concurrent.STM
+import Control.Exception (bracket)
+import Control.Lens ((^.))
+import Control.Monad
 import Control.Monad.Effect
+import Control.System (detectFlag, detectAllFlags)
+import Data.Text (Text)
 import Data.Time.Clock
 import Module.Logging
+import System.Environment (lookupEnv)
 import System.Log.FastLogger
-import System.Log.FastLogger.Internal (LogStr (..))
+import System.Log.FastLogger.Internal (LogStr(..))
+import Text.Read (readMaybe)
 import qualified Control.Monad.Logger as ML
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Lazy as BL
-import Data.List (foldl1')
-import Control.Exception (bracket)
+import qualified Options.Applicative as O
+import Data.Maybe
+import Data.List (intersperse)
+import Control.Arrow
+import Data.Word
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 
--- | Logger with a cleanup function
-data LoggerWithCleanup m log = LoggerWithCleanup
-  { baseLogFunc :: log -> m ()
+data LoggerWithCleanup m a = LoggerWithCleanup
+  { baseLogFunc :: a -> m ()
   , cleanUpFunc :: m ()
   }
 
-useBaseLogger :: ((LogStr -> m ()) -> Logger m logS) -> LoggerWithCleanup m LogStr -> LoggerWithCleanup m (Log logS)
-useBaseLogger makeLogger (LoggerWithCleanup logFunc cleanUp) =
-  LoggerWithCleanup (_runLogger $ makeLogger logFunc) cleanUp
-{-# INLINE useBaseLogger #-}
+data LogOrderControl
+  = LogTimeChunk
+  | LogCatChunk
+  | LogLocChunk
+  | LogSrcChunk
+  | LogDocChunk
+  deriving (Eq, Ord, Show)
 
--- | Primitive version of 'useBaseLogger'
-useBaseLogger' :: Monad m => (Log logS -> m LogStr) -> LoggerWithCleanup m LogStr -> LoggerWithCleanup m (Log logS)
-useBaseLogger' makeLogger (LoggerWithCleanup logFunc cleanUp) =
-  LoggerWithCleanup (makeLogger >=> logFunc) cleanUp
-{-# INLINE useBaseLogger' #-}
+data LoggerOptions = LoggerOptions
+  { loggerDocRenderOptions :: DocRenderOptions
+  , loggerIncludeTime      :: Bool
+  , loggerIncludeCats      :: Bool
+  , loggerIncludeLoc       :: Bool
+  , loggerIncludeSource    :: Bool
+  , loggerAppendNewline    :: Bool
+  , loggerJsonFormat       :: Bool
+  , loggerOrderControl     :: Maybe [LogOrderControl]
+  }
 
-liftBaseLogger :: (m () -> n ()) -> LoggerWithCleanup m log -> LoggerWithCleanup n log
-liftBaseLogger nat (LoggerWithCleanup f c) = LoggerWithCleanup (nat . f) (nat c)
-{-# INLINE liftBaseLogger #-}
+type LoggerStyle = LoggerOptions -> LoggerOptions
 
-instance Applicative m => Semigroup (LoggerWithCleanup m log) where
-  (LoggerWithCleanup l1 c1) <> (LoggerWithCleanup l2 c2) = LoggerWithCleanup (\l -> l1 l *> l2 l) (c1 *> c2)
-  {-# INLINE (<>) #-}
-instance Applicative m => Monoid (LoggerWithCleanup m log) where
+defaultLoggerStyle :: LoggerOptions
+defaultLoggerStyle =
+  LoggerOptions
+    { loggerDocRenderOptions = defaultDocRenderOptions
+    , loggerIncludeTime      = True
+    , loggerIncludeCats      = True
+    , loggerIncludeLoc       = True
+    , loggerIncludeSource    = True
+    , loggerAppendNewline    = True
+    , loggerJsonFormat       = False
+    , loggerOrderControl     = Nothing
+    }
+
+buildLoggerStyle :: LoggerStyle -> LoggerOptions
+buildLoggerStyle style = style defaultLoggerStyle
+
+loggerUseAnsi :: LoggerStyle
+loggerUseAnsi opts =
+  opts
+    { loggerDocRenderOptions =
+        (loggerDocRenderOptions opts) { docRenderStyleMode = AnsiStyles }
+    }
+
+loggerNoStyle :: LoggerStyle
+loggerNoStyle opts =
+  opts
+    { loggerDocRenderOptions =
+        (loggerDocRenderOptions opts) { docRenderStyleMode = NoStyles }
+    }
+
+loggerShowWith :: (forall a. Show a => a -> ML.LogStr) -> LoggerStyle
+loggerShowWith renderShown opts =
+  opts
+    { loggerDocRenderOptions =
+        (loggerDocRenderOptions opts) { docRenderShow = renderShown }
+    }
+
+loggerNoTime :: LoggerStyle
+loggerNoTime opts = opts {loggerIncludeTime = False}
+
+loggerNoCats :: LoggerStyle
+loggerNoCats opts = opts {loggerIncludeCats = False}
+
+loggerNoLoc :: LoggerStyle
+loggerNoLoc opts = opts {loggerIncludeLoc = False}
+
+loggerNoSource :: LoggerStyle
+loggerNoSource opts = opts {loggerIncludeSource = False}
+
+loggerNoNewline :: LoggerStyle
+loggerNoNewline opts = opts {loggerAppendNewline = False}
+
+loggerJson :: LoggerStyle
+loggerJson opts = opts {loggerJsonFormat = True}
+
+loggerOrder :: [LogOrderControl] -> LoggerStyle
+loggerOrder chunks opts = opts {loggerOrderControl = Just chunks}
+
+liftBaseLogger :: (m () -> n ()) -> LoggerWithCleanup m a -> LoggerWithCleanup n a
+liftBaseLogger nat (LoggerWithCleanup f cleanup) =
+  LoggerWithCleanup (nat . f) (nat cleanup)
+
+instance Applicative m => Semigroup (LoggerWithCleanup m a) where
+  LoggerWithCleanup logA cleanA <> LoggerWithCleanup logB cleanB =
+    LoggerWithCleanup (\entry -> logA entry *> logB entry) (cleanA *> cleanB)
+
+instance Applicative m => Monoid (LoggerWithCleanup m a) where
   mempty = LoggerWithCleanup (const $ pure ()) (pure ())
-  {-# INLINE mempty #-}
 
--- | It doesn't mean it is really fast, called 'FastBaseLogger' because it is imported from fast-logger
 createFastBaseLogger :: MonadIO m => LogType -> m (LoggerWithCleanup IO LogStr)
-createFastBaseLogger logT = liftIO $ uncurry LoggerWithCleanup <$> newFastLogger logT
+createFastBaseLogger logType =
+  liftIO $ uncurry LoggerWithCleanup <$> newFastLogger logType
 
--- | Uses the logger from fast-logger with default buffer-size
 createStdoutBaseLogger :: MonadIO m => m (LoggerWithCleanup IO LogStr)
 createStdoutBaseLogger = createFastBaseLogger (LogStdout defaultBufSize)
 
--- | A very simple logger that just prints to stdout **without buffering**.
--- Inlines a putStr function. Suitable for simple applications
 createSimpleStdoutBaseLogger :: MonadIO m => m (LoggerWithCleanup IO LogStr)
-createSimpleStdoutBaseLogger = liftIO $ do
-  let logFunc (LogStr _ builder) = BL.putStr (BB.toLazyByteString builder)
-  return $ LoggerWithCleanup logFunc (return ())
-{-# INLINE createSimpleStdoutBaseLogger #-}
+createSimpleStdoutBaseLogger =
+  liftIO $ do
+    let logFunc (LogStr _ builder) = BL.putStr (BB.toLazyByteString builder)
+    pure $ LoggerWithCleanup logFunc (pure ())
 
--- | A very simple concurrent logger that just prints to stdout **without buffering**.
--- A cleanUp function is provided to make sure all logs are printed before exiting.
 createSimpleConcurrentStdoutBaseLogger :: MonadIO m => m (LoggerWithCleanup IO LogStr)
-createSimpleConcurrentStdoutBaseLogger = liftIO $ do
-  queue <- newTQueueIO
-  counter <- newTVarIO (0 :: Int)
-  -- ^ the caller increments this when logging atomically
-  -- logger checks this to see if it should exit
-  let logFunc (LogStr _ builder) = do
-        atomically $ do
-          writeTQueue queue builder
-          modifyTVar' counter (+1)
-      rawLogFunc builder = BL.putStr (BB.toLazyByteString builder)
-      atomicLogFunc queue' = do
-        logStr <- atomically $ do
-          logStr <- readTQueue queue'
-          modifyTVar' counter (subtract 1)
-          return logStr
-        rawLogFunc logStr
-  let cleanUpFunc = do
-        remQ <- atomically $ do
-          r <- readTVar counter
-          if r == 0
-            then return Nothing
-            else do
-              b <- flushTQueue queue
-              writeTVar counter 0
-              return (Just b)
-        forM_ remQ (mapM_ rawLogFunc)
-  _ <- forkIO $ forever $ atomicLogFunc queue
-  return $ LoggerWithCleanup logFunc cleanUpFunc
+createSimpleConcurrentStdoutBaseLogger =
+  liftIO $ do
+    queue <- newTQueueIO
+    counter <- newTVarIO (0 :: Int)
+    let logFunc (LogStr _ builder) =
+          atomically $ do
+            writeTQueue queue builder
+            modifyTVar' counter (+ 1)
+        rawLogFunc builder = BL.putStr (BB.toLazyByteString builder)
+        atomicLogFunc queue' = do
+          builder <- atomically $ do
+            next <- readTQueue queue'
+            modifyTVar' counter (subtract 1)
+            pure next
+          rawLogFunc builder
+        cleanUpFunc tid = do
+          killThread tid
+          remaining <- atomically $ do
+            count <- readTVar counter
+            if count == 0
+              then pure Nothing
+              else do
+                builders <- flushTQueue queue
+                writeTVar counter 0
+                pure (Just builders)
+          forM_ remaining (mapM_ rawLogFunc)
+    tid <- forkIO $ forever $ atomicLogFunc queue
+    pure $ LoggerWithCleanup logFunc (cleanUpFunc tid)
 
--- | Uses the logger from fast-logger with default buffer-size
 createStderrBaseLogger :: MonadIO m => m (LoggerWithCleanup IO LogStr)
 createStderrBaseLogger = createFastBaseLogger (LogStderr defaultBufSize)
 
--- | Uses the logger from fast-logger with default buffer-size
 createFileLogger :: MonadIO m => FilePath -> m (LoggerWithCleanup IO LogStr)
-createFileLogger fp = createFastBaseLogger (LogFile (FileLogSpec fp (512 * 1024 * 1024) 3) defaultBufSize)
+createFileLogger fp =
+  createFastBaseLogger (LogFile (FileLogSpec fp (256 * 1024 * 1024) 2) defaultBufSize)
 
-type Timed = Bool
--- | this formats the logging data and sends it to the provided function
-simpleLogger :: MonadIO m => Timed -> (LogStr -> m ()) -> Logger m LogS
-simpleLogger time
-  = contramap logSimple
-  . contramap (<> "\n")
-  . (if time then timeLogger else id)
-  . typedLogger
-  . baseToLogger
+createFileLoggerWith :: MonadIO m => Integer -> Int -> FilePath -> m (LoggerWithCleanup IO LogStr)
+createFileLoggerWith size count fp =
+  createFastBaseLogger (LogFile (FileLogSpec fp size count) defaultBufSize)
 
--- | Render the inner data type into LogStr and pass to the provided logger accepting LogStr.
--- @
--- logWithRendering renderB = contramap $ fmap renderB
--- @
---
--- Example:
--- @
--- logWithRendering someRenderFunc (simpleLogger False baseLogFunc) :: Logger m (LogMsg b)
--- @
-logWithRendering :: (b -> LogStr) -> Logger m LogS -> Logger m (LogMsg b)
-logWithRendering renderB = contramap $ fmap renderB
-{-# INLINE logWithRendering #-}
+renderLogEvent :: LoggerOptions -> LogEvent (LogWithSourceMeta LogDoc) -> IO ML.LogStr
+renderLogEvent LoggerOptions {..} entry = do
+  let meta = entry ^. logEventPayload
+      docChunk = renderLogDoc loggerDocRenderOptions (meta ^. logMetaDoc)
+      catChunk =
+        if loggerIncludeCats && not (null (entry ^. logEventCats))
+          then squareBracket $ logSepList (map (renderLogDoc loggerDocRenderOptions . someLogCatDisplay) (entry ^. logEventCats))
+          else emptyField
+      locChunk =
+        if loggerIncludeLoc
+          then maybe emptyField renderLoc (meta ^. logMetaLoc)
+          else emptyField
+      srcChunk =
+        if loggerIncludeSource
+          then maybe emptyField ML.toLogStr (meta ^. logMetaSource)
+          else emptyField
+      suffix = if loggerAppendNewline then "\n" else mempty
+      orderControl = fromMaybe [LogTimeChunk, LogCatChunk, LogLocChunk, LogSrcChunk, LogDocChunk] loggerOrderControl
 
--- | simply apply the provided function to the log string
-baseToLogger :: (LogStr -> m ()) -> Logger m LogStr
-baseToLogger baseIO = Logger $ \(Log _ str) -> baseIO str
-{-# INLINE baseToLogger #-}
+      logSepList x = mconcat (intersperse sep $ map quote x)
 
--- | Modifies LogStr: add the types of the log to the log string on the left
-typedLogger :: Logger m LogStr -> Logger m LogStr
-typedLogger (Logger logFunc) = Logger $ \(Log types logStr) -> do
-  let typeNames = map someLogCatName types
-  let logLine
-        | null typeNames = logStr
-        | otherwise = "[" <> foldl1' (\x y -> x <> "|" <> y) typeNames <> "] " <> logStr
-  logFunc $ Log types logLine
-{-# INLINE typedLogger #-}
+      emptyField
+        | loggerJsonFormat = "null"
+        | otherwise        = mempty
 
--- | add the current time to the log string on the left
-timeLogger :: MonadIO m => Logger m LogStr -> Logger m LogStr
-timeLogger (Logger logger) = Logger $ \(Log types logStr) -> do
-  time <- liftIO getCurrentTime
-  let timeStr = toLogStr (show time)
-  logger $ Log types (timeStr <> "|" <> logStr)
-{-# INLINE timeLogger #-}
+      quote x = "\"" <> x <> "\""
 
--- | format the log data into a simple log string, utilizing log types, and location info (if any)
-logSimple :: LogS -> LogStr
-logSimple LogMsg {..}
-    =  maybe "" ((<> ",") . toLogStr . ML.loc_filename) _logLoc
-    <> maybe "" ((<> "-") . displayPos . ML.loc_start) _logLoc
-    <> maybe "" ((<> "|") . displayPos . ML.loc_end) _logLoc
-    <> maybe "" ((<> "|") . toLogStr) _logSource
-    <> _logMsg
-  where displayPos (l, c) = toLogStr (show l <> ":" <> show c)
-{-# INLINE logSimple #-}
+      quoteAndEscape x = quote (escape x)
 
--- | Bracket pattern, runs the action with the provided logger and cleans up afterwards
+      escape :: ML.LogStr -> ML.LogStr
+      escape
+        =   fromLogStr
+        >>> replace
+              [ (wordQuote    , B.pack [wordBackslash, wordQuote     ])
+              , (wordBackslash, B.pack [wordBackslash, wordBackslash ])
+              , (wordNewline  , B.pack [wordBackslash, wordN         ])
+              , (wordTab      , B.pack [wordBackslash, wordT         ])
+              , (wordCarriage , B.pack [wordBackslash, wordR         ])
+              ]
+        >>> map toLogStr
+        >>> mconcat
+        where
+          wordQuote     = 34  :: Word8
+          wordBackslash = 92  :: Word8
+          wordNewline   = 10  :: Word8
+          wordTab       = 9   :: Word8
+          wordCarriage  = 13  :: Word8
+          wordN         = 110 :: Word8
+          wordT         = 116 :: Word8
+          wordR         = 114 :: Word8
+
+      replace :: [(Word8, ByteString)] -> ByteString -> [ByteString]
+      replace works input =
+        let (prefix, work) = B.break (\c -> any (\(w, _) -> w == c) works) input
+        in case B.uncons work of
+          Nothing     -> [prefix]
+          Just (h, t) ->
+            prefix
+            : case lookup h works of
+                Nothing -> B.singleton h
+                Just r  -> r
+            : replace works t
+
+      squareBracket x = "[" <> x <> "]"
+
+      bigBracket x = "{" <> x <> "}"
+
+      ifJson :: (a -> a) -> a -> a
+      ifJson f x = if loggerJsonFormat then f x else x
+
+      sep = if loggerJsonFormat then "," else "|"
+
+      renderLoc loc =
+        objectLike
+          [ ("file" , ifJson quote $ ML.toLogStr (ML.loc_filename loc))
+          , ("start", ifJson quote $ displayPos (ML.loc_start loc))
+          , ("end"  , ifJson quote $ displayPos (ML.loc_end loc))
+          ]
+
+      objectLike :: [(ML.LogStr, ML.LogStr)] -> ML.LogStr
+      objectLike  = ifJson bigBracket
+                  . mconcat
+                  . intersperse sep
+                  . map (\(k, v) -> ifJson ((quote k <> ":") <>) v)
+
+      displayPos (line, col) = ML.toLogStr (show line <> ":" <> show col)
+
+  timeChunk <-
+    if loggerIncludeTime
+      then ML.toLogStr . show <$> getCurrentTime
+      else pure mempty
+  pure $ objectLike (map (\case
+           LogTimeChunk -> ("time", ifJson quote timeChunk)
+           LogCatChunk  -> ("type", catChunk)
+           LogLocChunk  -> ("loc" , locChunk)
+           LogSrcChunk  -> ("src" , srcChunk)
+           LogDocChunk  -> ("doc" , ifJson quoteAndEscape docChunk)
+         ) orderControl) <> suffix
+
+loggerFromRenderer
+  :: MonadIO m
+  => LoggerOptions
+  -> (ML.LogStr -> m ())
+  -> Logger m (LogWithSourceMeta LogDoc)
+loggerFromRenderer opts sink =
+  Logger $ \entry -> do
+    rendered <- liftIO $ renderLogEvent opts entry
+    sink rendered
+
+makeLoggerFromBase
+  :: MonadIO m
+  => LoggerOptions
+  -> LoggerWithCleanup m ML.LogStr
+  -> LoggerWithCleanup m (LogEvent (LogWithSourceMeta LogDoc))
+makeLoggerFromBase opts LoggerWithCleanup {..} =
+  LoggerWithCleanup
+    { baseLogFunc = runLogger (loggerFromRenderer opts baseLogFunc)
+    , cleanUpFunc = cleanUpFunc
+    }
+
 withLoggerCleanup
-  :: (ConsFDataList c (Logging m logS : mods), Monad m, MonadMask m)
-  => LoggerWithCleanup m (Log logS) -- ^ specify a logger with cleanup function
-  -> EffT' c (Logging m logS : mods) es m a
-  -> EffT' c mods es m a
-withLoggerCleanup (LoggerWithCleanup logger cleanUp) action = bracketEffT
-  (return ())
-  (\_ -> lift cleanUp)
-  (\_ -> runLogging (Logger logger) action)
-{-# INLINE withLoggerCleanup #-}
+  :: (ConsFDataList c (LogEffect m a : mods), Monad m, MonadMask m)
+  => LoggerWithCleanup m (LogEvent (LogWithSourceMeta a))
+  -> EffT' c (LogEffect m a : mods) es m b
+  -> EffT' c mods es m b
+withLoggerCleanup (LoggerWithCleanup logger cleanup) action =
+  bracketEffT
+    (pure ())
+    (\_ -> lift cleanup)
+    (\_ -> runLogEffect (Logger logger) action)
 
--- $ Bracket pattern
--- | This function is used to create a logger in a scoped manner.
--- It takes care of creating and cleaning up the base logger.
 withBaseLogger
-  :: (ConsFDataList c (Logging m (LogMsg logS) : mods), Monad m, MonadMask m)
-  => m (LoggerWithCleanup m LogStr)               -- ^ specify a base logger
-  -> ((LogStr -> m ()) -> Logger m (LogMsg logS)) -- ^ specify how to format the log data using the base logger
-  -> EffT' c (Logging m (LogMsg logS) : mods) es m a
+  :: (ConsFDataList c (LogEffect m LogDoc : mods), MonadIO m, MonadMask m)
+  => m (LoggerWithCleanup m ML.LogStr)
+  -> LoggerOptions
+  -> EffT' c (LogEffect m LogDoc : mods) es m a
   -> EffT' c mods es m a
-withBaseLogger createBaseLogger makeLogger action = bracketEffT
-  (lift createBaseLogger)
-  (\LoggerWithCleanup {cleanUpFunc} -> lift cleanUpFunc)
-  (\LoggerWithCleanup {baseLogFunc} -> runLogging (makeLogger baseLogFunc) action)
-{-# INLINE withBaseLogger #-}
+withBaseLogger createBaseLogger opts action =
+  bracketEffT
+    (lift createBaseLogger)
+    (\LoggerWithCleanup {cleanUpFunc} -> lift cleanUpFunc)
+    (\baseLogger ->
+       let logger = Logger (baseLogFunc (makeLoggerFromBase opts baseLogger))
+        in runLogEffect logger action
+    )
 
 withBaseLoggerIO
-  :: IO (LoggerWithCleanup IO LogStr)                    -- ^ specify a base logger
-  -> ((LogStr -> IO ()) -> Logger IO logS) -- ^ specify how to log logS using the base logger
-  -> (Logger IO logS -> IO a)  -- ^ action to run with the logger
+  :: IO (LoggerWithCleanup IO ML.LogStr)
+  -> LoggerOptions
+  -> (Logger IO (LogWithSourceMeta LogDoc) -> IO a)
   -> IO a
-withBaseLoggerIO createBaseLogger makeLogger action = bracket
-  (liftIO createBaseLogger)
-  (\LoggerWithCleanup {cleanUpFunc} -> liftIO cleanUpFunc)
-  (\LoggerWithCleanup {baseLogFunc} -> action (makeLogger baseLogFunc))
-{-# INLINE withBaseLoggerIO #-}
+withBaseLoggerIO createBaseLogger opts action =
+  bracket
+    createBaseLogger
+    cleanUpFunc
+    (\baseLogger -> action $ loggerFromRenderer opts baseLogger.baseLogFunc)
+
+----
+
+defaultLoggingFromEnv
+  :: LoggerWithCleanup IO (LogEvent (LogWithSourceMeta LogDoc))
+  -> IO (ModuleInitData LoggingModule)
+defaultLoggingFromEnv (LoggerWithCleanup logger cleanup) = do
+  mLevel <- (readMaybe =<<) <$> lookupEnv "LOG_LEVEL"
+  pure $ LogEffectInitData (Logger logger) (Just cleanup) id mLevel
+
+defaultLoggingFromArgs
+  :: LoggerWithCleanup IO (LogEvent (LogWithSourceMeta LogDoc))
+  -> [String]
+  -> Either Text (ModuleInitData LoggingModule)
+defaultLoggingFromArgs (LoggerWithCleanup logger cleanup) [] =
+  Right $ LogEffectInitData (Logger logger) (Just cleanup) id Nothing
+defaultLoggingFromArgs (LoggerWithCleanup logger cleanup) args = do
+  level <- maybe (Right Nothing) (fmap Just) $ detectFlag "--log-level" defaultStringToLogSeverity args
+  types <- sequence $ detectAllFlags "--log-type" (\case "" -> Left "Empty log type"; s -> Right s) args
+  nonTypes <- sequence $ detectAllFlags "--no-log-type" (\case "" -> Left "Empty log type"; s -> Right s) args
+  let transform =
+        foldr
+          (.)
+          id
+          ( [anyLogCat (isLogCatName name) | name <- types]
+              <> [excludeLogCat (isLogCatName name) | name <- nonTypes]
+          )
+  pure $ LogEffectInitData (Logger logger) (Just cleanup) transform level
+
+defaultLoggingOptParser
+  :: Applicative m
+  => LoggerWithCleanup m (LogEvent (LogWithSourceMeta LogDoc))
+  -> O.Parser (ModuleInitData (LogEffect m LogDoc))
+defaultLoggingOptParser (LoggerWithCleanup logger cleanup) = do
+  level <-
+    O.optional $
+      O.option O.auto
+        ( O.long "log-level"
+            <> O.metavar "LEVEL"
+            <> O.help "Log level, one of 'Debug', 'Info', 'Warn', 'Error', or a number between 0 and 10 with a precision of 1 decimal place"
+        )
+  types :: [String] <-
+    O.many $
+      O.option O.str
+        ( O.long "log-type"
+            <> O.metavar "TYPE"
+            <> O.help "Log type, can be specified multiple times"
+        )
+  nonTypes :: [String] <-
+    O.many $
+      O.option O.str
+        ( O.long "no-log-type"
+            <> O.metavar "TYPE"
+            <> O.help "Log type to exclude, can be specified multiple times"
+        )
+  pure $
+    LogEffectInitData
+      (Logger logger)
+      (Just cleanup)
+      (foldr (.) id $ [anyLogCat (isLogCatName name) | name <- types] <> [excludeLogCat (isLogCatName name) | name <- nonTypes])
+      level
diff --git a/src/Module/Logging/TraceId.hs b/src/Module/Logging/TraceId.hs
--- a/src/Module/Logging/TraceId.hs
+++ b/src/Module/Logging/TraceId.hs
@@ -1,27 +1,45 @@
-{-# LANGUAGE AllowAmbiguousTypes, QuasiQuotes, DeriveLift #-}
--- | This module provides functionality for handling trace IDs in logging.
---
---  A trace Id is a unique identifier used to trace and correlate log entries across different parts of a system.
---  It is particularly useful in systems for tracking requests as they propagate through various services.
-module Module.Logging.TraceId where
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE QuasiQuotes #-}
 
+module Module.Logging.TraceId
+  ( -- * Types
+    TraceId(..)
+    -- * Modules
+  , TraceIdGen
+  , newTraceId
+  , WithTraceId
+  , traceId
+    -- * Attaching Trace IDs
+  , withTraceId
+  , withNewTraceId
+  , runWithTraceIdIn
+    -- * Trace ID Generators
+  , withRandomTraceIdGen
+  , withTimeTraceIdGen
+  , withCountingTraceIdGen
+  , withStartTimeCountingTraceIdGen
+  , runTraceIdGen
+  , runTraceIdGenIn
+  , TraceIdGenRead
+  , WithTraceIdRead
+  ) where
+
 import Control.Concurrent.STM
 import Control.Monad.Effect
-import Control.Monad.Logger
+import Control.Monad.Logger (toLogStr)
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Data.TypeList
 import Data.Word
-import Data.Aeson (FromJSON, ToJSON)
 import Module.Logging
-import Module.RS.QQ
 import Module.Logging.TraceId.XorShiftRNG
+import Module.RS.QQ
 
-newtype TraceId = TraceId { unTraceId :: Word64 }
+newtype TraceId = TraceId {unTraceId :: Word64}
   deriving newtype (Eq, Ord, Show, FromJSON, ToJSON)
 
 instance IsLogCat TraceId where
-  logTypeDisplay (TraceId tid) = "TID=" <> toLogStr tid
-  {-# INLINE logTypeDisplay #-}
+  logTypeName (TraceId tid) = "TID=" <> toLogStr tid
 
 [makeRModule__|
 TraceIdGen
@@ -33,86 +51,67 @@
   traceId :: !TraceId
 |]
 
--- | Assign the provided traceId to the logging context
 withTraceId
-  :: forall log m mods es a.
+  :: forall doc m mods es a.
      ( Monad m
-     , Logging m log `In`    mods
-     , WithTraceId   `NotIn` mods
+     , LogEffect m doc `In` mods
+     , WithTraceId `NotIn` mods
      , ConsFDataList FData (WithTraceId : mods)
      )
-  => TraceId -> EffT (WithTraceId : mods) es m a -> EffT mods es m a
-withTraceId tid = effAddLogCat @log (LogCat tid) . runWithTraceId (WithTraceIdRead tid)
-{-# INLINE withTraceId #-}
-
--- | Specialized for log = LogS
-withTraceId'
-  :: forall log m mods es a.
-     ( Monad m
-     , Logging m log `In`    mods
-     , WithTraceId   `NotIn` mods
-     , ConsFDataList FData (WithTraceId : mods)
-     , log ~ LogS
-     )
-  => TraceId -> EffT (WithTraceId : mods) es m a -> EffT mods es m a
-withTraceId' = withTraceId @log
-{-# INLINE withTraceId' #-}
+  => TraceId
+  -> EffT (WithTraceId : mods) es m a
+  -> EffT mods es m a
+withTraceId tid =
+  effAddLogCat @doc (LogCat tid) . runWithTraceId (WithTraceIdRead tid)
 
--- | Assign new traceId using the provided TraceIdGen module
 withNewTraceId
-  :: forall log m mods es a.
+  :: forall doc m mods es a.
      ( MonadIO m
-     , TraceIdGen     `In`    mods
-     , Logging m log  `In`    mods
-     , WithTraceId    `NotIn` mods
-     , ConsFDataList  FData   (WithTraceId : mods)
+     , TraceIdGen `In` mods
+     , LogEffect m doc `In` mods
+     , WithTraceId `NotIn` mods
+     , ConsFDataList FData (WithTraceId : mods)
      )
-  => EffT (WithTraceId : mods) es m a -> EffT mods es m a
+  => EffT (WithTraceId : mods) es m a
+  -> EffT mods es m a
 withNewTraceId act = do
-  newTidIO <- asksModule newTraceId
-  newTrace <- liftIO     newTidIO
-  withTraceId @log newTrace act
-{-# INLINE withNewTraceId #-}
+  mkTraceId <- asksModule newTraceId
+  tid <- liftIO mkTraceId
+  withTraceId @doc tid act
 
--- | Using a global XorShift random number generator for traceId
 withRandomTraceIdGen
   :: (MonadIO m, ConsFDataList FData (TraceIdGen : mods))
-  => EffT (TraceIdGen : mods) es m a -> EffT mods es m a
+  => EffT (TraceIdGen : mods) es m a
+  -> EffT mods es m a
 withRandomTraceIdGen act = do
   rng <- liftIO newRNG
   runTraceIdGen (TraceIdGenRead $ TraceId <$> uniformWord64FromRNG rng) act
-{-# INLINE withRandomTraceIdGen #-}
 
--- | Using current time in microsecond precision for traceId
 withTimeTraceIdGen
   :: (MonadIO m, ConsFDataList FData (TraceIdGen : mods))
-  => EffT (TraceIdGen : mods) es m a -> EffT mods es m a
-withTimeTraceIdGen act = do
-  runTraceIdGen (TraceIdGenRead $ TraceId . floor . (*1000_000) <$> getPOSIXTime) act
-{-# INLINE withTimeTraceIdGen #-}
+  => EffT (TraceIdGen : mods) es m a
+  -> EffT mods es m a
+withTimeTraceIdGen act =
+  runTraceIdGen (TraceIdGenRead $ TraceId . floor . (* 1000_000) <$> getPOSIXTime) act
 
--- | Using a simple counting number for traceId, starting from the provided number
 withCountingTraceIdGen
   :: (MonadIO m, ConsFDataList FData (TraceIdGen : mods))
-  => Word64  -- ^ starting count, e.g. you can use microsecond unix time
+  => Word64
   -> EffT (TraceIdGen : mods) es m a
   -> EffT mods es m a
 withCountingTraceIdGen startCount act = do
   counter <- liftIO $ newTVarIO startCount
-  let getNewTid = atomically $ do
-        tid <- readTVar counter
-        let !newTid = tid + 1
-        writeTVar counter newTid
-        return $ TraceId tid
-  runTraceIdGen (TraceIdGenRead getNewTid) act
-{-# INLINE withCountingTraceIdGen #-}
+  let nextTraceId = atomically $ do
+        current <- readTVar counter
+        let newValue = current + 1
+        writeTVar counter newValue
+        pure $ TraceId current
+  runTraceIdGen (TraceIdGenRead nextTraceId) act
 
--- | Using current time in microsecond precision as the starting point for a counting traceId generator
 withStartTimeCountingTraceIdGen
   :: (MonadIO m, ConsFDataList FData (TraceIdGen : mods))
   => EffT (TraceIdGen : mods) es m a
   -> EffT mods es m a
 withStartTimeCountingTraceIdGen act = do
-  startTime <- liftIO $ floor . (*1000_000) <$> getPOSIXTime
+  startTime <- liftIO $ floor . (* 1000_000) <$> getPOSIXTime
   withCountingTraceIdGen startTime act
-{-# INLINE withStartTimeCountingTraceIdGen #-}
diff --git a/src/Module/Logging/TraceId/XorShiftRNG.hs b/src/Module/Logging/TraceId/XorShiftRNG.hs
--- a/src/Module/Logging/TraceId/XorShiftRNG.hs
+++ b/src/Module/Logging/TraceId/XorShiftRNG.hs
@@ -39,7 +39,7 @@
   in  z2 `xor` (z2 `shiftR` 31)
 {-# INLINE mix64 #-}
 
--- ----------------------------------------------------------------------------- 
+-- -----------------------------------------------------------------------------
 -- | Turn one seed into @n@ independent seeds suitable for different threads.
 --
 --   *   Deterministic: same parent → same list.