{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Colog.Message
(
SimpleMsg (..)
, logText
, fmtSimpleMessage
, formatWith
, Msg (..)
, Message
, log
, logDebug
, logInfo
, logWarning
, logError
, logException
, fmtMessage
, showSeverity
, showSourceLoc
, showTime
, showTimeOffset
, showThreadId
, FieldType
, MessageField (..)
, unMessageField
, extractField
, FieldMap
, defaultFieldMap
, RichMessage
, RichMsg (..)
, fmtRichMessageDefault
, fmtSimpleRichMessageDefault
, fmtRichMessageCustomDefault
, upgradeMessageAction
) where
import Prelude hiding (lookup, log)
import Control.Concurrent (ThreadId, myThreadId)
import Control.Exception (Exception, displayException)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Dependent.Map (DMap, fromList, lookup)
import Data.Dependent.Sum (DSum ((:=>)))
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import GHC.Stack (CallStack, SrcLoc (..), callStack, getCallStack, withFrozenCallStack)
import GHC.TypeLits (Symbol)
import System.Console.ANSI (Color (..), ColorIntensity (Vivid), ConsoleLayer (Foreground), SGR (..),
setSGRCode)
import Type.Reflection (TypeRep, typeRep)
import Colog.Core (LogAction, Severity (..), cmap)
import Colog.Monad (WithLog, logMsg)
import qualified Chronos as C
import qualified Chronos.Locale.English as C
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.Builder.Int as TB
import qualified Data.Vector as Vector
data Msg sev = Msg
{ forall sev. Msg sev -> sev
msgSeverity :: !sev
, forall sev. Msg sev -> CallStack
msgStack :: !CallStack
, forall sev. Msg sev -> Text
msgText :: Text
}
data SimpleMsg = SimpleMsg
{ SimpleMsg -> CallStack
simpleMsgStack :: !CallStack
, SimpleMsg -> Text
simpleMsgText :: !Text
}
type Message = Msg Severity
log :: WithLog env (Msg sev) m => sev -> Text -> m ()
log :: forall env sev (m :: * -> *).
WithLog env (Msg sev) m =>
sev -> Text -> m ()
log sev
msgSeverity Text
msgText =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall msg env (m :: * -> *). WithLog env msg m => msg -> m ()
logMsg Msg{ msgStack :: CallStack
msgStack = HasCallStack => CallStack
callStack, sev
Text
msgText :: Text
msgSeverity :: sev
msgText :: Text
msgSeverity :: sev
.. })
logDebug :: WithLog env Message m => Text -> m ()
logDebug :: forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall env sev (m :: * -> *).
WithLog env (Msg sev) m =>
sev -> Text -> m ()
log Severity
Debug)
logInfo :: WithLog env Message m => Text -> m ()
logInfo :: forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall env sev (m :: * -> *).
WithLog env (Msg sev) m =>
sev -> Text -> m ()
log Severity
Info)
logWarning :: WithLog env Message m => Text -> m ()
logWarning :: forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logWarning = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall env sev (m :: * -> *).
WithLog env (Msg sev) m =>
sev -> Text -> m ()
log Severity
Warning)
logError :: WithLog env Message m => Text -> m ()
logError :: forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logError = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall env sev (m :: * -> *).
WithLog env (Msg sev) m =>
sev -> Text -> m ()
log Severity
Error)
logException :: forall e m env . (WithLog env Message m, Exception e) => e -> m ()
logException :: forall e (m :: * -> *) env.
(WithLog env Message m, Exception e) =>
e -> m ()
logException = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> String
displayException)
logText :: WithLog env SimpleMsg m => Text -> m ()
logText :: forall env (m :: * -> *). WithLog env SimpleMsg m => Text -> m ()
logText Text
msgText = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (forall msg env (m :: * -> *). WithLog env msg m => msg -> m ()
logMsg SimpleMsg{ simpleMsgStack :: CallStack
simpleMsgStack = HasCallStack => CallStack
callStack, simpleMsgText :: Text
simpleMsgText = Text
msgText })
fmtMessage :: Message -> Text
fmtMessage :: Message -> Text
fmtMessage Msg{CallStack
Text
Severity
msgText :: Text
msgStack :: CallStack
msgSeverity :: Severity
msgText :: forall sev. Msg sev -> Text
msgStack :: forall sev. Msg sev -> CallStack
msgSeverity :: forall sev. Msg sev -> sev
..} =
Severity -> Text
showSeverity Severity
msgSeverity
forall a. Semigroup a => a -> a -> a
<> CallStack -> Text
showSourceLoc CallStack
msgStack
forall a. Semigroup a => a -> a -> a
<> Text
msgText
fmtSimpleMessage :: SimpleMsg -> Text
fmtSimpleMessage :: SimpleMsg -> Text
fmtSimpleMessage SimpleMsg{CallStack
Text
simpleMsgText :: Text
simpleMsgStack :: CallStack
simpleMsgText :: SimpleMsg -> Text
simpleMsgStack :: SimpleMsg -> CallStack
..} = CallStack -> Text
showSourceLoc CallStack
simpleMsgStack forall a. Semigroup a => a -> a -> a
<> Text
simpleMsgText
formatWith :: (msg -> Text) -> LogAction m Text -> LogAction m msg
formatWith :: forall msg (m :: * -> *).
(msg -> Text) -> LogAction m Text -> LogAction m msg
formatWith = forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap
{-# INLINE formatWith #-}
showSeverity :: Severity -> Text
showSeverity :: Severity -> Text
showSeverity = \case
Severity
Debug -> Color -> Text -> Text
color Color
Green Text
"[Debug] "
Severity
Info -> Color -> Text -> Text
color Color
Blue Text
"[Info] "
Severity
Warning -> Color -> Text -> Text
color Color
Yellow Text
"[Warning] "
Severity
Error -> Color -> Text -> Text
color Color
Red Text
"[Error] "
where
color :: Color -> Text -> Text
color :: Color -> Text -> Text
color Color
c Text
txt =
String -> Text
T.pack ([SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c])
forall a. Semigroup a => a -> a -> a
<> Text
txt
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([SGR] -> String
setSGRCode [SGR
Reset])
square :: Text -> Text
square :: Text -> Text
square Text
t = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"] "
showSourceLoc :: CallStack -> Text
showSourceLoc :: CallStack -> Text
showSourceLoc CallStack
cs = Text -> Text
square Text
showCallStack
where
showCallStack :: Text
showCallStack :: Text
showCallStack = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
[] -> Text
"<unknown loc>"
[(String
name, SrcLoc
loc)] -> String -> SrcLoc -> Text
showLoc String
name SrcLoc
loc
(String
_, SrcLoc
loc) : (String
callerName, SrcLoc
_) : [(String, SrcLoc)]
_ -> String -> SrcLoc -> Text
showLoc String
callerName SrcLoc
loc
showLoc :: String -> SrcLoc -> Text
showLoc :: String -> SrcLoc -> Text
showLoc String
name SrcLoc{Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..} =
String -> Text
T.pack String
srcLocModule forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
name forall a. Semigroup a => a -> a -> a
<> Text
"#" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
srcLocStartLine)
type family FieldType (fieldName :: Symbol) :: Type
type instance FieldType "threadId" = ThreadId
type instance FieldType "posixTime" = C.Time
newtype MessageField (m :: Type -> Type) (fieldName :: Symbol) where
MessageField :: forall fieldName m . m (FieldType fieldName) -> MessageField m fieldName
unMessageField :: forall fieldName m . MessageField m fieldName -> m (FieldType fieldName)
unMessageField :: forall (fieldName :: Symbol) (m :: * -> *).
MessageField m fieldName -> m (FieldType fieldName)
unMessageField (MessageField m (FieldType fieldName)
f) = m (FieldType fieldName)
f
{-# INLINE unMessageField #-}
extractField
:: Applicative m
=> Maybe (MessageField m fieldName)
-> m (Maybe (FieldType fieldName))
= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (fieldName :: Symbol) (m :: * -> *).
MessageField m fieldName -> m (FieldType fieldName)
unMessageField
{-# INLINE extractField #-}
type FieldMap m = DMap TypeRep (MessageField m)
defaultFieldMap :: MonadIO m => FieldMap m
defaultFieldMap :: forall (m :: * -> *). MonadIO m => FieldMap m
defaultFieldMap = forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
fromList
[ forall {k} (a :: k). Typeable a => TypeRep a
typeRep @"threadId" forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall (fieldName :: Symbol) (m :: * -> *).
m (FieldType fieldName) -> MessageField m fieldName
MessageField (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId)
, forall {k} (a :: k). Typeable a => TypeRep a
typeRep @"posixTime" forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall (fieldName :: Symbol) (m :: * -> *).
m (FieldType fieldName) -> MessageField m fieldName
MessageField (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Time
C.now)
]
data RichMsg (m :: Type -> Type) (msg :: Type) = RichMsg
{ forall (m :: * -> *) msg. RichMsg m msg -> msg
richMsgMsg :: !msg
, forall (m :: * -> *) msg. RichMsg m msg -> FieldMap m
richMsgMap :: {-# UNPACK #-} !(FieldMap m)
} deriving stock (forall a b. a -> RichMsg m b -> RichMsg m a
forall a b. (a -> b) -> RichMsg m a -> RichMsg m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> RichMsg m b -> RichMsg m a
forall (m :: * -> *) a b. (a -> b) -> RichMsg m a -> RichMsg m b
<$ :: forall a b. a -> RichMsg m b -> RichMsg m a
$c<$ :: forall (m :: * -> *) a b. a -> RichMsg m b -> RichMsg m a
fmap :: forall a b. (a -> b) -> RichMsg m a -> RichMsg m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> RichMsg m a -> RichMsg m b
Functor)
type RichMessage m = RichMsg m Message
fmtRichMessageDefault :: MonadIO m => RichMessage m -> m Text
fmtRichMessageDefault :: forall (m :: * -> *). MonadIO m => RichMessage m -> m Text
fmtRichMessageDefault RichMessage m
msg = forall (m :: * -> *) msg.
MonadIO m =>
RichMsg m msg
-> (Maybe ThreadId -> Maybe Time -> msg -> Text) -> m Text
fmtRichMessageCustomDefault RichMessage m
msg Maybe ThreadId -> Maybe Time -> Message -> Text
formatRichMessage
where
formatRichMessage :: Maybe ThreadId -> Maybe C.Time -> Message -> Text
formatRichMessage :: Maybe ThreadId -> Maybe Time -> Message -> Text
formatRichMessage (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ThreadId -> Text
showThreadId -> Text
thread) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Time -> Text
showTime -> Text
time) Msg{CallStack
Text
Severity
msgText :: Text
msgStack :: CallStack
msgSeverity :: Severity
msgText :: forall sev. Msg sev -> Text
msgStack :: forall sev. Msg sev -> CallStack
msgSeverity :: forall sev. Msg sev -> sev
..} =
Severity -> Text
showSeverity Severity
msgSeverity
forall a. Semigroup a => a -> a -> a
<> Text
time
forall a. Semigroup a => a -> a -> a
<> CallStack -> Text
showSourceLoc CallStack
msgStack
forall a. Semigroup a => a -> a -> a
<> Text
thread
forall a. Semigroup a => a -> a -> a
<> Text
msgText
fmtSimpleRichMessageDefault :: MonadIO m => RichMsg m SimpleMsg -> m Text
fmtSimpleRichMessageDefault :: forall (m :: * -> *). MonadIO m => RichMsg m SimpleMsg -> m Text
fmtSimpleRichMessageDefault RichMsg m SimpleMsg
msg = forall (m :: * -> *) msg.
MonadIO m =>
RichMsg m msg
-> (Maybe ThreadId -> Maybe Time -> msg -> Text) -> m Text
fmtRichMessageCustomDefault RichMsg m SimpleMsg
msg Maybe ThreadId -> Maybe Time -> SimpleMsg -> Text
formatRichMessage
where
formatRichMessage :: Maybe ThreadId -> Maybe C.Time -> SimpleMsg -> Text
formatRichMessage :: Maybe ThreadId -> Maybe Time -> SimpleMsg -> Text
formatRichMessage (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ThreadId -> Text
showThreadId -> Text
thread) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Time -> Text
showTime -> Text
time) SimpleMsg{CallStack
Text
simpleMsgText :: Text
simpleMsgStack :: CallStack
simpleMsgText :: SimpleMsg -> Text
simpleMsgStack :: SimpleMsg -> CallStack
..} =
Text
time
forall a. Semigroup a => a -> a -> a
<> CallStack -> Text
showSourceLoc CallStack
simpleMsgStack
forall a. Semigroup a => a -> a -> a
<> Text
thread
forall a. Semigroup a => a -> a -> a
<> Text
simpleMsgText
fmtRichMessageCustomDefault
:: MonadIO m
=> RichMsg m msg
-> (Maybe ThreadId -> Maybe C.Time -> msg -> Text)
-> m Text
fmtRichMessageCustomDefault :: forall (m :: * -> *) msg.
MonadIO m =>
RichMsg m msg
-> (Maybe ThreadId -> Maybe Time -> msg -> Text) -> m Text
fmtRichMessageCustomDefault RichMsg{msg
FieldMap m
richMsgMap :: FieldMap m
richMsgMsg :: msg
richMsgMap :: forall (m :: * -> *) msg. RichMsg m msg -> FieldMap m
richMsgMsg :: forall (m :: * -> *) msg. RichMsg m msg -> msg
..} Maybe ThreadId -> Maybe Time -> msg -> Text
formatter = do
Maybe ThreadId
maybeThreadId <- forall (m :: * -> *) (fieldName :: Symbol).
Applicative m =>
Maybe (MessageField m fieldName) -> m (Maybe (FieldType fieldName))
extractField forall a b. (a -> b) -> a -> b
$ forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
lookup (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @"threadId") FieldMap m
richMsgMap
Maybe Time
maybePosixTime <- forall (m :: * -> *) (fieldName :: Symbol).
Applicative m =>
Maybe (MessageField m fieldName) -> m (Maybe (FieldType fieldName))
extractField forall a b. (a -> b) -> a -> b
$ forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
lookup (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @"posixTime") FieldMap m
richMsgMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe ThreadId -> Maybe Time -> msg -> Text
formatter Maybe ThreadId
maybeThreadId Maybe Time
maybePosixTime msg
richMsgMsg
showTime :: C.Time -> Text
showTime :: Time -> Text
showTime Time
t =
Text -> Text
square
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText
forall a b. (a -> b) -> a -> b
$ OffsetDatetime -> Builder
builderDmyHMSz (Offset -> Time -> OffsetDatetime
C.timeToOffsetDatetime (Int -> Offset
C.Offset Int
0) Time
t)
showTimeOffset :: C.OffsetDatetime -> Text
showTimeOffset :: OffsetDatetime -> Text
showTimeOffset = Text -> Text
square forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> Builder
builderDmyHMSz
builderDmyHMSz :: C.OffsetDatetime -> TB.Builder
builderDmyHMSz :: OffsetDatetime -> Builder
builderDmyHMSz (C.OffsetDatetime (C.Datetime Date
date TimeOfDay
time) Offset
offset) =
Date -> Builder
builderDmy Date
date
forall a. Semigroup a => a -> a -> a
<> Builder
spaceSep
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
C.builder_HMS (Int -> SubsecondPrecision
C.SubsecondPrecisionFixed Int
3) (forall a. a -> Maybe a
Just Char
':') TimeOfDay
time
forall a. Semigroup a => a -> a -> a
<> Builder
spaceSep
forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
C.builderOffset OffsetFormat
C.OffsetFormatColonOn Offset
offset
where
spaceSep :: TB.Builder
spaceSep :: Builder
spaceSep = Char -> Builder
TB.singleton Char
' '
builderDmy :: C.Date -> TB.Builder
builderDmy :: Date -> Builder
builderDmy (C.Date (C.Year Int
y) Month
m DayOfMonth
d) =
DayOfMonth -> Builder
zeroPadDayOfMonth DayOfMonth
d
forall a. Semigroup a => a -> a -> a
<> Builder
spaceSep
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText (forall a. MonthMatch a -> Month -> a
C.caseMonth MonthMatch Text
C.abbreviated Month
m)
forall a. Semigroup a => a -> a -> a
<> Builder
spaceSep
forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int
y
zeroPadDayOfMonth :: C.DayOfMonth -> TB.Builder
zeroPadDayOfMonth :: DayOfMonth -> Builder
zeroPadDayOfMonth (C.DayOfMonth Int
d) =
if Int
d forall a. Ord a => a -> a -> Bool
< Int
100
then forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector Builder
twoDigitTextBuilder Int
d
else forall a. Integral a => a -> Builder
TB.decimal Int
d
twoDigitTextBuilder :: Vector.Vector TB.Builder
twoDigitTextBuilder :: Vector Builder
twoDigitTextBuilder = forall a. [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
twoDigitStrings
{-# NOINLINE twoDigitTextBuilder #-}
twoDigitStrings :: [String]
twoDigitStrings :: [String]
twoDigitStrings =
[ String
"00",String
"01",String
"02",String
"03",String
"04",String
"05",String
"06",String
"07",String
"08",String
"09"
, String
"10",String
"11",String
"12",String
"13",String
"14",String
"15",String
"16",String
"17",String
"18",String
"19"
, String
"20",String
"21",String
"22",String
"23",String
"24",String
"25",String
"26",String
"27",String
"28",String
"29"
, String
"30",String
"31",String
"32",String
"33",String
"34",String
"35",String
"36",String
"37",String
"38",String
"39"
, String
"40",String
"41",String
"42",String
"43",String
"44",String
"45",String
"46",String
"47",String
"48",String
"49"
, String
"50",String
"51",String
"52",String
"53",String
"54",String
"55",String
"56",String
"57",String
"58",String
"59"
, String
"60",String
"61",String
"62",String
"63",String
"64",String
"65",String
"66",String
"67",String
"68",String
"69"
, String
"70",String
"71",String
"72",String
"73",String
"74",String
"75",String
"76",String
"77",String
"78",String
"79"
, String
"80",String
"81",String
"82",String
"83",String
"84",String
"85",String
"86",String
"87",String
"88",String
"89"
, String
"90",String
"91",String
"92",String
"93",String
"94",String
"95",String
"96",String
"97",String
"98",String
"99"
]
showThreadId :: ThreadId -> Text
showThreadId :: ThreadId -> Text
showThreadId = Text -> Text
square forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
upgradeMessageAction
:: forall m msg .
FieldMap m
-> LogAction m (RichMsg m msg)
-> LogAction m msg
upgradeMessageAction :: forall (m :: * -> *) msg.
FieldMap m -> LogAction m (RichMsg m msg) -> LogAction m msg
upgradeMessageAction FieldMap m
fieldMap = forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap msg -> RichMsg m msg
addMap
where
addMap :: msg -> RichMsg m msg
addMap :: msg -> RichMsg m msg
addMap msg
msg = forall (m :: * -> *) msg. msg -> FieldMap m -> RichMsg m msg
RichMsg msg
msg FieldMap m
fieldMap