From e5d8ca9c124c4f8805bba9212845f0e21de5d9fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Tue, 23 Jun 2026 21:43:56 +0200 Subject: Format chatroom messages with Conversation module --- src/Erebos/Chatroom.hs | 5 +++++ src/Erebos/Conversation.hs | 12 ++++++++---- src/Erebos/Conversation/Class.hs | 8 ++++++++ 3 files changed, 21 insertions(+), 4 deletions(-) (limited to 'src/Erebos') diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs index fce8b1d..c535845 100644 --- a/src/Erebos/Chatroom.hs +++ b/src/Erebos/Chatroom.hs @@ -67,6 +67,11 @@ instance ConversationType ChatroomState ChatMessage where convMessageTime = cmsgTime convMessageText = cmsgText + convMessageExtra msg + | cmsgLeave msg = [ UserLeft ] + | Nothing <- cmsgText msg = [ UserJoined ] + | otherwise = [] + convReference = refDigest . storedRef . head . filterAncestors . concatMap storedRoots . roomStateData convMessageListSince mbSince cstate = ( 0, ) $ diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs index 0e6690e..78774bd 100644 --- a/src/Erebos/Conversation.hs +++ b/src/Erebos/Conversation.hs @@ -74,11 +74,15 @@ formatMessage :: TimeZone -> Message -> String formatMessage tzone = T.unpack . renderPlainText . formatMessageFT tzone formatMessageFT :: TimeZone -> Message -> FormattedText -formatMessageFT tzone msg = mconcat - [ PlainText $ T.pack $ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ messageTime msg - , maybe "" PlainText $ idName $ messageFrom msg - , maybe "" ((": " <>) . PlainText) $ messageText msg +formatMessageFT tzone msg = mconcat $ concat + [ [ PlainText $ T.pack $ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ messageTime msg ] + , [ maybe "" PlainText $ idName $ messageFrom msg ] + , map formatExtra $ withMessage convMessageExtra msg + , [ maybe "" ((": " <>) . PlainText) $ messageText msg ] ] + where + formatExtra UserJoined = " " <> withStyle (setForegroundColor BrightMagenta noStyle) (plainText "joined") + formatExtra UserLeft = " " <> withStyle (setForegroundColor Magenta noStyle) (plainText "left") data Conversation diff --git a/src/Erebos/Conversation/Class.hs b/src/Erebos/Conversation/Class.hs index d7bac5d..7c3652d 100644 --- a/src/Erebos/Conversation/Class.hs +++ b/src/Erebos/Conversation/Class.hs @@ -1,5 +1,6 @@ module Erebos.Conversation.Class ( ConversationType(..), + MessageExtra(..), RefDigest, ) where @@ -15,10 +16,17 @@ import Erebos.Object import Erebos.State +data MessageExtra + = UserJoined + | UserLeft + + class (Typeable conv, Typeable msg) => ConversationType conv msg | conv -> msg, msg -> conv where convMessageFrom :: msg -> ComposedIdentity convMessageTime :: msg -> ZonedTime convMessageText :: msg -> Maybe Text + convMessageExtra :: msg -> [ MessageExtra ] + convMessageExtra _ = [] convReference :: conv -> RefDigest convMessageListSince -- cgit v1.2.3