summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-05-19 21:37:46 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-05-23 21:10:12 +0200
commit620e5840aba91d683bf7b4ee115079550aae8569 (patch)
treed813fa3b2be9085d45612fe381b0892d4cb119cc /src
parent49db4661634b364ea49758666623a2efc3ac7107 (diff)
Conversation interface
Changelog: Added `/conversations` command to list and select conversations
Diffstat (limited to 'src')
-rw-r--r--src/Erebos/Conversation.hs75
-rw-r--r--src/Erebos/Message.hs7
2 files changed, 81 insertions, 1 deletions
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
new file mode 100644
index 0000000..94d2399
--- /dev/null
+++ b/src/Erebos/Conversation.hs
@@ -0,0 +1,75 @@
+module Erebos.Conversation (
+ Message,
+ messageFrom,
+ messageText,
+ messageUnread,
+ formatMessage,
+
+ Conversation,
+ directMessageConversation,
+ reloadConversation,
+ lookupConversations,
+
+ conversationName,
+ conversationPeer,
+ conversationHistory,
+
+ sendMessage,
+) where
+
+import Control.Monad.Except
+
+import Data.List
+import Data.Maybe
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Time.LocalTime
+
+import Erebos.Identity
+import Erebos.Message hiding (formatMessage)
+import Erebos.State
+import Erebos.Storage
+
+
+data Message = DirectMessageMessage DirectMessage Bool
+
+messageFrom :: Message -> ComposedIdentity
+messageFrom (DirectMessageMessage msg _) = msgFrom msg
+
+messageText :: Message -> Maybe Text
+messageText (DirectMessageMessage msg _) = Just $ msgText msg
+
+messageUnread :: Message -> Bool
+messageUnread (DirectMessageMessage _ unread) = unread
+
+formatMessage :: TimeZone -> Message -> String
+formatMessage tzone (DirectMessageMessage msg _) = formatDirectMessage tzone msg
+
+
+data Conversation = DirectMessageConversation DirectMessageThread
+
+directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
+directMessageConversation peer = do
+ (find (sameIdentity peer . msgPeer) . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
+ Just thread -> return $ DirectMessageConversation thread
+ Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] []
+
+reloadConversation :: MonadHead LocalState m => Conversation -> m Conversation
+reloadConversation (DirectMessageConversation thread) = directMessageConversation (msgPeer thread)
+
+lookupConversations :: MonadHead LocalState m => m [Conversation]
+lookupConversations = map DirectMessageConversation . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead
+
+
+conversationName :: Conversation -> Text
+conversationName (DirectMessageConversation thread) = fromMaybe (T.pack "<unnamed>") $ idName $ msgPeer thread
+
+conversationPeer :: Conversation -> Maybe ComposedIdentity
+conversationPeer (DirectMessageConversation thread) = Just $ msgPeer thread
+
+conversationHistory :: Conversation -> [Message]
+conversationHistory (DirectMessageConversation thread) = map (\msg -> DirectMessageMessage msg False) $ threadToList thread
+
+
+sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m Message
+sendMessage (DirectMessageConversation thread) text = DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False
diff --git a/src/Erebos/Message.hs b/src/Erebos/Message.hs
index ea86ca0..f8ad2cf 100644
--- a/src/Erebos/Message.hs
+++ b/src/Erebos/Message.hs
@@ -14,6 +14,7 @@ module Erebos.Message (
watchReceivedMessages,
formatMessage,
+ formatDirectMessage,
) where
import Control.Monad
@@ -258,8 +259,12 @@ watchReceivedMessages h f = do
forM_ (map fromStored sms) $ \ms -> do
mapM_ f $ filter (not . sameIdentity self . msgFrom . fromStored) $ msReceived ms
+{-# DEPRECATED formatMessage "use formatDirectMessage instead" #-}
formatMessage :: TimeZone -> DirectMessage -> String
-formatMessage tzone msg = concat
+formatMessage = formatDirectMessage
+
+formatDirectMessage :: TimeZone -> DirectMessage -> String
+formatDirectMessage tzone msg = concat
[ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ msgTime msg
, maybe "<unnamed>" T.unpack $ idName $ msgFrom msg
, ": "