Format chatroom messages with Conversation module

3 files changed, 21 insertions, 4 deletions

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 "<unnamed>" 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 "<unnamed>" 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