summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--main/Main.hs2
-rw-r--r--main/Test.hs6
-rw-r--r--src/Erebos/Conversation.hs10
-rw-r--r--src/Erebos/DirectMessage.hs34
4 files changed, 26 insertions, 26 deletions
diff --git a/main/Main.hs b/main/Main.hs
index 68bbc8a..974038f 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -369,7 +369,7 @@ interactiveLoop st opts = withTerminal commandCompletion $ \term -> do
_ <- liftIO $ do
tzone <- getCurrentTimeZone
- watchReceivedMessages erebosHead $ \smsg -> do
+ watchReceivedDirectMessages erebosHead $ \smsg -> do
let msg = fromStored smsg
extPrintLn $ formatDirectMessage tzone msg
case optDmBotEcho opts of
diff --git a/main/Test.hs b/main/Test.hs
index e697a91..0dee8aa 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -442,7 +442,7 @@ cmdHeadUnwatch = do
initTestHead :: Head LocalState -> Command
initTestHead h = do
- _ <- liftIO . watchReceivedMessages h . dmReceivedWatcher =<< asks tiOutput
+ _ <- liftIO . watchReceivedDirectMessages h . dmReceivedWatcher =<< asks tiOutput
modify $ \s -> s { tsHead = Just h }
loadTestHead :: CommandM (Head LocalState)
@@ -849,10 +849,10 @@ cmdDmSendIdentity = do
dmList :: Foldable f => Identity f -> Command
dmList peer = do
- threads <- toThreadList . lookupSharedValue . lsShared . headObject <$> getHead
+ threads <- dmThreadList . lookupSharedValue . lsShared . headObject <$> getHead
case find (sameIdentity peer . msgPeer) threads of
Just thread -> do
- forM_ (reverse $ threadToList thread) $ \DirectMessage {..} -> cmdOut $ "dm-list-item"
+ forM_ (reverse $ dmThreadToList thread) $ \DirectMessage {..} -> cmdOut $ "dm-list-item"
<> " from " <> (maybe "<unnamed>" T.unpack $ idName msgFrom)
<> " text " <> (T.unpack msgText)
Nothing -> return ()
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
index 1e3bad4..c882e23 100644
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -81,7 +81,7 @@ isSameConversation _ _ = False
directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
directMessageConversation peer = do
- (find (sameIdentity peer . msgPeer) . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
+ (find (sameIdentity peer . msgPeer) . dmThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
Just thread -> return $ DirectMessageConversation thread
Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] [] []
@@ -96,8 +96,8 @@ reloadConversation (DirectMessageConversation thread) = directMessageConversatio
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
@@ -108,8 +108,8 @@ 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 :: Conversation -> [ Message ]
+conversationHistory (DirectMessageConversation thread) = map (\msg -> DirectMessageMessage msg False) $ dmThreadToList thread
conversationHistory (ChatroomConversation rstate) = map (\msg -> ChatroomMessage msg False) $ roomStateMessages rstate
diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index dc6724c..7eba91f 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -6,13 +6,13 @@ module Erebos.DirectMessage (
defaultDirectMessageAttributes,
DirectMessageThreads,
- toThreadList,
+ dmThreadList,
DirectMessageThread(..),
- threadToList,
- messageThreadView,
+ dmThreadToList,
+ dmThreadView,
- watchReceivedMessages,
+ watchReceivedDirectMessages,
formatDirectMessage,
) where
@@ -94,7 +94,7 @@ instance Service DirectMessage where
, msReceived = received'
, msSeen = []
}
- let threads = DirectMessageThreads [next] (messageThreadView [next])
+ let threads = DirectMessageThreads [ next ] (dmThreadView [ next ])
shared <- makeSharedStateUpdate st threads (lsShared $ fromStored erb)
svcSetLocal =<< wrappedStore st (fromStored erb) { lsShared = [shared] }
@@ -125,8 +125,8 @@ data DirectMessageThreads = DirectMessageThreads [Stored MessageState] [DirectMe
instance Eq DirectMessageThreads where
DirectMessageThreads mss _ == DirectMessageThreads mss' _ = mss == mss'
-toThreadList :: DirectMessageThreads -> [DirectMessageThread]
-toThreadList (DirectMessageThreads _ threads) = threads
+dmThreadList :: DirectMessageThreads -> [ DirectMessageThread ]
+dmThreadList (DirectMessageThreads _ threads) = threads
instance Storable MessageState where
store' MessageState {..} = storeRec $ do
@@ -148,7 +148,7 @@ instance Storable MessageState where
instance Mergeable DirectMessageThreads where
type Component DirectMessageThreads = MessageState
- mergeSorted mss = DirectMessageThreads mss (messageThreadView mss)
+ mergeSorted mss = DirectMessageThreads mss (dmThreadView mss)
toComponents (DirectMessageThreads mss _) = mss
instance SharedType DirectMessageThreads where
@@ -185,7 +185,7 @@ sendDirectMessage pid text = updateLocalState $ \ls -> do
, msReceived = []
, msSeen = []
}
- return (DirectMessageThreads [next] (messageThreadView [next]), smsg)
+ return ( DirectMessageThreads [ next ] (dmThreadView [ next ]), smsg )
syncDirectMessageToPeer :: DirectMessageThreads -> ServiceHandler DirectMessage ()
syncDirectMessageToPeer (DirectMessageThreads mss _) = do
@@ -210,13 +210,13 @@ syncDirectMessageToPeer (DirectMessageThreads mss _) = do
, msReceived = []
, msSeen = []
}
- return $ DirectMessageThreads [next] (messageThreadView [next])
+ return $ DirectMessageThreads [ next ] (dmThreadView [ next ])
else do
return unchanged
findMissingPeers :: Server -> DirectMessageThreads -> ExceptT ErebosError IO ()
findMissingPeers server threads = do
- forM_ (toThreadList threads) $ \thread -> do
+ forM_ (dmThreadList threads) $ \thread -> do
when (msgHead thread /= msgReceived thread) $ do
mapM_ (discoverySearch server) $ map (refDigest . storedRef) $ idDataF $ msgPeer thread
@@ -229,16 +229,16 @@ data DirectMessageThread = DirectMessageThread
, msgReceived :: [ Stored DirectMessage ]
}
-threadToList :: DirectMessageThread -> [DirectMessage]
-threadToList thread = helper S.empty $ msgHead thread
+dmThreadToList :: DirectMessageThread -> [ DirectMessage ]
+dmThreadToList thread = helper S.empty $ msgHead thread
where helper seen msgs
| msg : msgs' <- filter (`S.notMember` seen) $ reverse $ sortBy (comparing cmpView) msgs =
fromStored msg : helper (S.insert msg seen) (msgs' ++ msgPrev (fromStored msg))
| otherwise = []
cmpView msg = (zonedTimeToUTC $ msgTime $ fromStored msg, msg)
-messageThreadView :: [Stored MessageState] -> [DirectMessageThread]
-messageThreadView = helper []
+dmThreadView :: [ Stored MessageState ] -> [ DirectMessageThread ]
+dmThreadView = helper []
where helper used ms' = case filterAncestors ms' of
mss@(sms : rest)
| any (sameIdentity $ msPeer $ fromStored sms) used ->
@@ -264,8 +264,8 @@ messageThreadFor peer mss =
}
-watchReceivedMessages :: Head LocalState -> (Stored DirectMessage -> IO ()) -> IO WatchedHead
-watchReceivedMessages h f = do
+watchReceivedDirectMessages :: Head LocalState -> (Stored DirectMessage -> IO ()) -> IO WatchedHead
+watchReceivedDirectMessages h f = do
let self = finalOwner $ localIdentity $ headObject h
watchHeadWith h (lookupSharedValue . lsShared . headObject) $ \(DirectMessageThreads sms _) -> do
forM_ (map fromStored sms) $ \ms -> do
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-04 03:27:03 +0000