Unify code to create HTML for messages

1 files changed, 16 insertions, 21 deletions

diff --git a/src/Main.hs b/src/Main.hs
index f96f872..0a87665 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -161,22 +161,13 @@ setup = do
             Left err -> JS.consoleLog $ "Failed to set name: " <> showErebosError err
 
     messagesList <- JS.getElementById "msg_list"
-    tzone <- getCurrentTimeZone
     void $ watchDirectMessageThreads globalHead $ \prev cur -> do
         withMVar currentConversationVar $ \case
             SelectedConversation conv
               | maybe False (msgPeer cur `sameIdentity`) (conversationPeer conv)
               -> do
-                mbSelf <- join . fmap (lookupSharedValue @(Maybe ComposedIdentity) . lsShared . headObject) <$> reloadHead globalHead
-                forM_ (reverse $ dmThreadToListSince prev cur) $ \msg -> do
-                    li <- js_document_createElement (toJSString "li")
-                    js_set_textContent li $ toJSString $ formatDirectMessage tzone msg
-                    case mbSelf of
-                        Just self -> js_classList_add li $
-                            if msgFrom msg `sameIdentity` self then toJSString "sent" else toJSString "received"
-                        Nothing -> return ()
-                    ul <- js_get_firstChild messagesList
-                    js_appendChild ul li
+                ul <- js_get_firstChild messagesList
+                appendMessages gs ul $ map Left $ reverse $ dmThreadToListSince prev cur
 
             _ -> return ()
 
@@ -340,24 +331,28 @@ watchConversations gs@GlobalState {..} = do
 
             return conversations
 
-selectConversation :: GlobalState -> Conversation -> IO ()
-selectConversation GlobalState {..} conv = do
-    void $ swapMVar currentConversationVar (SelectedConversation conv)
-    header <- JS.getElementById "msg_header"
-    messagesList <- JS.getElementById "msg_list"
-
+appendMessages :: GlobalState -> JSVal -> [ Either DirectMessage Message ] -> IO ()
+appendMessages GlobalState {..} ul msgs = do
     tzone <- getCurrentTimeZone
-    ul <- js_document_createElement (toJSString "ul")
     mbSelf <- join . fmap (lookupSharedValue @(Maybe ComposedIdentity) . lsShared . headObject) <$> reloadHead globalHead
-    forM_ (reverse $ conversationHistory conv) $ \msg -> do
+    forM_ msgs $ \msg -> do
         li <- js_document_createElement (toJSString "li")
-        js_set_textContent li $ toJSString $ formatMessage tzone msg
+        js_set_textContent li $ toJSString $ either (formatDirectMessage tzone) (formatMessage tzone) msg
         case mbSelf of
             Just self -> js_classList_add li $
-                if messageFrom msg `sameIdentity` self then toJSString "sent" else toJSString "received"
+                if either msgFrom messageFrom msg `sameIdentity` self then toJSString "sent" else toJSString "received"
             Nothing -> return ()
         js_appendChild ul li
 
+selectConversation :: GlobalState -> Conversation -> IO ()
+selectConversation gs@GlobalState {..} conv = do
+    void $ swapMVar currentConversationVar (SelectedConversation conv)
+    header <- JS.getElementById "msg_header"
+    messagesList <- JS.getElementById "msg_list"
+
+    ul <- js_document_createElement (toJSString "ul")
+    appendMessages gs ul $ map Right $ reverse $ conversationHistory conv
+
     js_set_textContent header $ toJSString $ T.unpack $ conversationName conv
     js_replaceChildren messagesList ul