From c3d5c3d17058efb7c20d05f18a6b713c674552d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Mon, 16 Feb 2026 22:31:49 +0100 Subject: Unify code to create HTML for messages --- src/Main.hs | 37 ++++++++++++++++--------------------- 1 file 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 -- cgit v1.2.3