1 files changed, 41 insertions, 23 deletions
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
index dee6faa..2c6f967 100644
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -7,9 +7,11 @@ module Erebos.Conversation (
     formatMessage,
 
     Conversation,
+    isSameConversation,
     directMessageConversation,
     chatroomConversation,
     chatroomConversationByStateData,
+    isChatroomStateConversation,
     reloadConversation,
     lookupConversations,
 
@@ -31,47 +33,60 @@ import Data.Time.Format
 import Data.Time.LocalTime
 
 import Erebos.Chatroom
+import Erebos.Conversation.Class
 import Erebos.DirectMessage
 import Erebos.Identity
 import Erebos.State
 import Erebos.Storable
 
 
-data Message = DirectMessageMessage DirectMessage Bool
-             | ChatroomMessage ChatMessage Bool
+data Message = forall conv msg. ConversationType conv msg => Message msg Bool
+
+withMessage :: (forall conv msg. ConversationType conv msg => msg -> a) -> Message -> a
+withMessage f (Message msg _) = f msg
 
 messageFrom :: Message -> ComposedIdentity
-messageFrom (DirectMessageMessage msg _) = msgFrom msg
-messageFrom (ChatroomMessage msg _) = cmsgFrom msg
+messageFrom = withMessage convMessageFrom
 
 messageTime :: Message -> ZonedTime
-messageTime (DirectMessageMessage msg _) = msgTime msg
-messageTime (ChatroomMessage msg _) = cmsgTime msg
+messageTime = withMessage convMessageTime
 
 messageText :: Message -> Maybe Text
-messageText (DirectMessageMessage msg _) = Just $ msgText msg
-messageText (ChatroomMessage msg _) = cmsgText msg
+messageText = withMessage convMessageText
 
 messageUnread :: Message -> Bool
-messageUnread (DirectMessageMessage _ unread) = unread
-messageUnread (ChatroomMessage _ unread) = unread
+messageUnread (Message _ unread) = unread
 
 formatMessage :: TimeZone -> Message -> String
 formatMessage tzone msg = concat
-    [ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ messageTime msg
+    [ if messageUnread msg then "\ESC[93m" else ""
+    , formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ messageTime msg
     , maybe "<unnamed>" T.unpack $ idName $ messageFrom msg
     , maybe "" ((": "<>) . T.unpack) $ messageText msg
+    , if messageUnread msg then "\ESC[0m" else ""
     ]
 
 
-data Conversation = DirectMessageConversation DirectMessageThread
-                  | ChatroomConversation ChatroomState
+data Conversation
+    = DirectMessageConversation DirectMessageThread
+    | ChatroomConversation ChatroomState
+
+withConversation :: (forall conv msg. ConversationType conv msg => conv -> a) -> Conversation -> a
+withConversation f (DirectMessageConversation conv) = f conv
+withConversation f (ChatroomConversation conv) = f conv
+
+isSameConversation :: Conversation -> Conversation -> Bool
+isSameConversation (DirectMessageConversation t) (DirectMessageConversation t')
+    = sameIdentity (msgPeer t) (msgPeer t')
+isSameConversation (ChatroomConversation rstate) (ChatroomConversation rstate') = isSameChatroom rstate rstate'
+isSameConversation _ _ = False
 
 directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
 directMessageConversation peer = do
-    (find (sameIdentity peer . msgPeer) . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
+    createOrUpdateDirectMessagePeer peer
+    (find (sameIdentity peer . msgPeer) . dmThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
         Just thread -> return $ DirectMessageConversation thread
-        Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] []
+        Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] [] []
 
 chatroomConversation :: MonadHead LocalState m => ChatroomState -> m (Maybe Conversation)
 chatroomConversation rstate = chatroomConversationByStateData (head $ roomStateData rstate)
@@ -79,13 +94,17 @@ chatroomConversation rstate = chatroomConversationByStateData (head $ roomStateD
 chatroomConversationByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe Conversation)
 chatroomConversationByStateData sdata = fmap ChatroomConversation <$> findChatroomByStateData sdata
 
+isChatroomStateConversation :: ChatroomState -> Conversation -> Bool
+isChatroomStateConversation rstate (ChatroomConversation rstate') = isSameChatroom rstate rstate'
+isChatroomStateConversation _ _ = False
+
 reloadConversation :: MonadHead LocalState m => Conversation -> m Conversation
 reloadConversation (DirectMessageConversation thread) = directMessageConversation (msgPeer thread)
 reloadConversation cur@(ChatroomConversation rstate) =
     fromMaybe cur <$> chatroomConversation rstate
 
-lookupConversations :: MonadHead LocalState m => m [Conversation]
-lookupConversations = map DirectMessageConversation . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead
+lookupConversations :: MonadHead LocalState m => m [ Conversation ]
+lookupConversations = map DirectMessageConversation . dmThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead
 
 
 conversationName :: Conversation -> Text
@@ -96,14 +115,13 @@ conversationPeer :: Conversation -> Maybe ComposedIdentity
 conversationPeer (DirectMessageConversation thread) = Just $ msgPeer thread
 conversationPeer (ChatroomConversation _) = Nothing
 
-conversationHistory :: Conversation -> [Message]
-conversationHistory (DirectMessageConversation thread) = map (\msg -> DirectMessageMessage msg False) $ threadToList thread
-conversationHistory (ChatroomConversation rstate) = map (\msg -> ChatroomMessage msg False) $ roomStateMessages rstate
+conversationHistory :: Conversation -> [ Message ]
+conversationHistory = withConversation $ map (uncurry Message) . convMessageListSince Nothing
 
 
-sendMessage :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Conversation -> Text -> m (Maybe Message)
-sendMessage (DirectMessageConversation thread) text = fmap Just $ DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False
-sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text >> return Nothing
+sendMessage :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Conversation -> Text -> m ()
+sendMessage (DirectMessageConversation thread) text = sendDirectMessage (msgPeer thread) text
+sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text
 
 deleteConversation :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Conversation -> m ()
 deleteConversation (DirectMessageConversation _) = throwOtherError "deleting direct message conversation is not supported"