diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 4bdfa30137..371a83411e 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -3,6 +3,7 @@ module Main where import Control.Concurrent (threadDelay) +import Data.Time.Clock (getCurrentTime) import Server import Simplex.Chat.Controller (versionNumber) import Simplex.Chat.Core @@ -27,7 +28,8 @@ main = do simplexChatTerminal terminalChatConfig opts t else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do r <- sendChatCmd cc chatCmd - putStrLn $ serializeChatResponse (Just user) r + ts <- getCurrentTime + putStrLn $ serializeChatResponse (Just user) ts r threadDelay $ chatCmdDelay opts * 1000000 welcome :: ChatOpts -> IO () diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 6ddc135152..77c024b18c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1015,11 +1015,11 @@ processChatCommand = \case quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg) let mc = MCText $ safeDecodeUtf8 msg processChatCommand . APISendMessage (ChatRef CTGroup groupId) $ ComposedMessage Nothing (Just quotedItemId) mc - LastMessages (Just chatName) count -> withUser $ \user -> do + LastMessages (Just chatName) count search -> withUser $ \user -> do chatRef <- getChatRef user chatName - CRLastMessages . aChatItems . chat <$> processChatCommand (APIGetChat chatRef (CPLast count) Nothing) - LastMessages Nothing count -> withUser $ \user -> withStore $ \db -> - CRLastMessages <$> getAllChatItems db user (CPLast count) + CRLastMessages . aChatItems . chat <$> processChatCommand (APIGetChat chatRef (CPLast count) search) + LastMessages Nothing count search -> withUser $ \user -> withStore $ \db -> + CRLastMessages <$> getAllChatItems db user (CPLast count) search SendFile chatName f -> withUser $ \user -> do chatRef <- getChatRef user chatName processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCFile "") @@ -3166,7 +3166,7 @@ chatCommandP = "/sql chat " *> (ExecChatStoreSQL <$> textP), "/sql agent " *> (ExecAgentStoreSQL <$> textP), "/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)), - "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional searchP), + "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), "/_get items count=" *> (APIGetChatItems <$> A.decimal), "/_send " *> (APISendMessage <$> chatRefP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> msgContentP), @@ -3259,7 +3259,8 @@ chatCommandP = ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> A.takeByteString), ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> A.takeByteString), "/feed " *> (SendMessageBroadcast <$> A.takeByteString), - ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP), + ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), + ("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))), ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath), ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath), ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal), @@ -3319,8 +3320,8 @@ chatCommandP = n <- (A.space *> A.takeByteString) <|> pure "" pure $ if B.null n then name else safeDecodeUtf8 n textP = safeDecodeUtf8 <$> A.takeByteString - filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString - searchP = T.unpack . safeDecodeUtf8 <$> (" search=" *> A.takeByteString) + stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString + filePath = stringP memberRole = A.choice [ " owner" $> GROwner, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 87458782fb..df267f98b2 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -235,7 +235,7 @@ data ChatCommand | DeleteGroupLink GroupName | ShowGroupLink GroupName | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString} - | LastMessages (Maybe ChatName) Int + | LastMessages (Maybe ChatName) Int (Maybe String) | SendFile ChatName FilePath | SendImage ChatName FilePath | ForwardFile ChatName FileTransferId diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index ef4ed4991f..d157f0dfea 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -155,6 +155,12 @@ messagesHelpInfo = indent <> highlight "/tail #team [N] " <> " - the last N messages in the group team", indent <> highlight "/tail [N] " <> " - the last N messages in all chats", "", + green "Search for messages", + indent <> highlight "/search @alice [N] " <> " - the last N messages with alice containing (10 by default)", + indent <> highlight "/search #team [N] " <> " - the last N messages in the group team containing ", + indent <> highlight "/search [N] " <> " - the last N messages in all chats containing ", + indent <> highlight "/?" <> " can be used instead of /search", + "", green "Sending replies to messages", "To quote a message that starts with \"hi\":", indent <> highlight "> @alice (hi) " <> " - to reply to alice's most recent message", @@ -164,8 +170,8 @@ messagesHelpInfo = "", green "Deleting sent messages (for everyone)", "To delete a message that starts with \"hi\":", - indent <> highlight "\\ @alice hi " <> " - to delete your message to alice", - indent <> highlight "\\ #team hi " <> " - to delete your message in the group #team", + indent <> highlight "\\ @alice hi " <> " - to delete your message to alice", + indent <> highlight "\\ #team hi " <> " - to delete your message in the group #team", "", green "Editing sent messages", "To edit your last message press up arrow, edit (keep the initial ! symbol) and press enter.", diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index e506615741..c69ae463f8 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -3680,15 +3680,16 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou (ldn, currentTs, userId, groupId) DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) -getAllChatItems :: DB.Connection -> User -> ChatPagination -> ExceptT StoreError IO [AChatItem] -getAllChatItems db user pagination = do +getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] +getAllChatItems db user pagination search_ = do + let search = fromMaybe "" search_ case pagination of - CPLast count -> getAllChatItemsLast_ db user count + CPLast count -> getAllChatItemsLast_ db user count search CPAfter _afterId _count -> throwError $ SEInternalError "not implemented" CPBefore _beforeId _count -> throwError $ SEInternalError "not implemented" -getAllChatItemsLast_ :: DB.Connection -> User -> Int -> ExceptT StoreError IO [AChatItem] -getAllChatItemsLast_ db user@User {userId} count = do +getAllChatItemsLast_ :: DB.Connection -> User -> Int -> String -> ExceptT StoreError IO [AChatItem] +getAllChatItemsLast_ db user@User {userId} count search = do itemRefs <- liftIO $ reverse . rights . map toChatItemRef @@ -3697,11 +3698,11 @@ getAllChatItemsLast_ db user@User {userId} count = do [sql| SELECT chat_item_id, contact_id, group_id FROM chat_items - WHERE user_id = ? + WHERE user_id = ? AND item_text LIKE '%' || ? || '%' ORDER BY item_ts DESC, chat_item_id DESC LIMIT ? |] - (userId, count) + (userId, search, count) mapM (uncurry $ getAChatItem_ db user) itemRefs getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index fa167d2784..6c7ea54cdb 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -12,6 +12,7 @@ import Control.Monad.Reader import Data.List (dropWhileEnd) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (getCurrentTime) import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Styled @@ -41,7 +42,8 @@ runInputLoop ct cc = forever $ do _ -> pure () let testV = testView $ config cc user <- readTVarIO $ currentUser cc - printToTerminal ct $ responseToView user testV r + ts <- getCurrentTime + printToTerminal ct $ responseToView user testV ts r where echo s = printToTerminal ct [plain s] isMessage = \case diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 522b9bb486..3f04357da7 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -10,6 +10,7 @@ module Simplex.Chat.Terminal.Output where import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift import Control.Monad.Reader +import Data.Time.Clock (getCurrentTime) import Simplex.Chat.Controller import Simplex.Chat.Styled import Simplex.Chat.View @@ -78,7 +79,8 @@ runTerminalOutput ct cc = do forever $ do (_, r) <- atomically . readTBQueue $ outputQ cc user <- readTVarIO $ currentUser cc - printToTerminal ct $ responseToView user testV r + ts <- getCurrentTime + printToTerminal ct $ responseToView user testV ts r printToTerminal :: ChatTerminal -> [StyledString] -> IO () printToTerminal ct s = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index c3d03f4159..3a795fb2a1 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -21,7 +21,7 @@ import Data.List (groupBy, intercalate, intersperse, partition, sortOn) import Data.Maybe (isJust, isNothing, mapMaybe) import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Clock (DiffTime) +import Data.Time.Clock (DiffTime, UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToZonedTime) import GHC.Generics (Generic) @@ -49,11 +49,13 @@ import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Util (bshow) import System.Console.ANSI.Types -serializeChatResponse :: Maybe User -> ChatResponse -> String -serializeChatResponse user_ = unlines . map unStyle . responseToView user_ False +type CurrentTime = UTCTime -responseToView :: Maybe User -> Bool -> ChatResponse -> [StyledString] -responseToView user_ testView = \case +serializeChatResponse :: Maybe User -> CurrentTime -> ChatResponse -> String +serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ False ts + +responseToView :: Maybe User -> Bool -> CurrentTime -> ChatResponse -> [StyledString] +responseToView user_ testView ts = \case CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRChatStarted -> ["chat started"] CRChatRunning -> ["chat is running"] @@ -69,13 +71,13 @@ responseToView user_ testView = \case CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats CRContactSwitch ct progress -> viewContactSwitch ct progress CRGroupMemberSwitch g m progress -> viewGroupMemberSwitch g m progress - CRNewChatItem (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False - CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems + CRNewChatItem (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts + CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems CRChatItemStatusUpdated _ -> [] - CRChatItemUpdated (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item - CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem + CRChatItemUpdated (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item ts + CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem ts CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"] - CRBroadcastSent mc n ts -> viewSentBroadcast mc n ts + CRBroadcastSent mc n t -> viewSentBroadcast mc n ts t CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr CRCmdAccepted _ -> [] CRCmdOk -> ["ok"] @@ -256,8 +258,8 @@ showSMPServer = B.unpack . strEncode . host viewHostEvent :: AProtocolType -> TransportHost -> String viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h) -viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString] -viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of +viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString] +viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow ts = case chat of DirectChat c -> case chatDir of CIDirectSnd -> case content of CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc @@ -267,7 +269,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = c to = ttyToContact' c CIDirectRcv -> case content of CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc - CIRcvIntegrityError err -> viewRcvIntegrityError from err meta + CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta CIRcvGroupEvent {} -> showRcvItemProhibited from _ -> showRcvItem from where @@ -283,7 +285,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = c to = ttyToGroup g CIGroupRcv m -> case content of CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc - CIRcvIntegrityError err -> viewRcvIntegrityError from err meta + CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta CIRcvGroupInvitation {} -> showRcvItemProhibited from _ -> showRcvItem from where @@ -294,26 +296,26 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = c where withSndFile = withFile viewSentFileInvitation withRcvFile = withFile viewReceivedFileInvitation - withFile view dir l = maybe l (\f -> l <> view dir f meta) file + withFile view dir l = maybe l (\f -> l <> view dir f ts meta) file sndMsg = msg viewSentMessage rcvMsg = msg viewReceivedMessage msg view dir quote mc = case (msgContentText mc, file, quote) of ("", Just _, []) -> [] - ("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) meta - _ -> view dir quote mc meta - showSndItem to = showItem $ sentWithTime_ [to <> plainContent content] meta - showRcvItem from = showItem $ receivedWithTime_ from [] meta [plainContent content] - showSndItemProhibited to = showItem $ sentWithTime_ [to <> plainContent content <> " " <> prohibited] meta - showRcvItemProhibited from = showItem $ receivedWithTime_ from [] meta [plainContent content <> " " <> prohibited] + ("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts meta + _ -> view dir quote mc ts meta + showSndItem to = showItem $ sentWithTime_ ts [to <> plainContent content] meta + showRcvItem from = showItem $ receivedWithTime_ ts from [] meta [plainContent content] + showSndItemProhibited to = showItem $ sentWithTime_ ts [to <> plainContent content <> " " <> prohibited] meta + showRcvItemProhibited from = showItem $ receivedWithTime_ ts from [] meta [plainContent content <> " " <> prohibited] showItem ss = if doShow then ss else [] plainContent = plain . ciContentToText prohibited = styled (colored Red) ("[prohibited - it's a bug if this chat item was created in this context, please report it to dev team]" :: String) -viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] -viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of +viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> CurrentTime -> [StyledString] +viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} ts = case chat of DirectChat Contact {localDisplayName = c} -> case chatDir of CIDirectRcv -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta + CIRcvMsgContent mc -> viewReceivedMessage from quote mc ts meta _ -> [] where from = ttyFromContactEdited c @@ -321,7 +323,7 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of CIDirectSnd -> ["message updated"] GroupChat g -> case chatDir of CIGroupRcv GroupMember {localDisplayName = m} -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta + CIRcvMsgContent mc -> viewReceivedMessage from quote mc ts meta _ -> [] where from = ttyFromGroupEdited g m @@ -329,16 +331,16 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of CIGroupSnd -> ["message updated"] _ -> [] -viewItemDelete :: ChatInfo c -> ChatItem c d -> ChatItem c' d' -> [StyledString] -viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem {content = toContent} = case chat of +viewItemDelete :: ChatInfo c -> ChatItem c d -> ChatItem c' d' -> CurrentTime -> [StyledString] +viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem {content = toContent} ts = case chat of DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent, toContent) of (CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of - CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc meta + CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc ts meta CIDMInternal -> ["message deleted"] _ -> ["message deleted"] GroupChat g -> case (chatDir, deletedContent, toContent) of (CIGroupRcv GroupMember {localDisplayName = m}, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of - CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] mc meta + CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] mc ts meta CIDMInternal -> ["message deleted"] _ -> ["message deleted"] _ -> [] @@ -365,8 +367,8 @@ msgPreview = msgPlain . preview . msgContentText | T.length t <= 120 = t | otherwise = T.take 120 t <> "..." -viewRcvIntegrityError :: StyledString -> MsgErrorType -> CIMeta 'MDRcv -> [StyledString] -viewRcvIntegrityError from msgErr meta = receivedWithTime_ from [] meta $ viewMsgIntegrityError msgErr +viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> CIMeta 'MDRcv -> [StyledString] +viewRcvIntegrityError from msgErr ts meta = receivedWithTime_ ts from [] meta $ viewMsgIntegrityError msgErr viewMsgIntegrityError :: MsgErrorType -> [StyledString] viewMsgIntegrityError err = msgError $ case err of @@ -802,36 +804,37 @@ viewContactUpdated where fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName' -viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString] -viewReceivedMessage from quote mc meta = receivedWithTime_ from quote meta (ttyMsgContent mc) +viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta d -> [StyledString] +viewReceivedMessage from quote mc ts meta = receivedWithTime_ ts from quote meta (ttyMsgContent mc) -receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString] -receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do - prependFirst (formattedTime <> " " <> from) (quote <> prependFirst indent styledMsg) - where - indent = if null quote then "" else " " - formattedTime :: StyledString - formattedTime = - let localTime = zonedTimeToLocalTime localItemTs - tz = zonedTimeZone localItemTs - format = - if (localDay localTime < localDay (zonedTimeToLocalTime $ utcToZonedTime tz createdAt)) - && (timeOfDayToTime (localTimeOfDay localTime) > (6 * 60 * 60 :: DiffTime)) - then "%m-%d" -- if message is from yesterday or before and 6 hours has passed since midnight - else "%H:%M" - in styleTime $ formatTime defaultTimeLocale format localTime - -viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString] -viewSentMessage to quote mc = sentWithTime_ (prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc)) +receivedWithTime_ :: CurrentTime -> StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString] +receivedWithTime_ ts from quote CIMeta {localItemTs} styledMsg = do + prependFirst (ttyMsgTime ts localItemTs <> " " <> from) (quote <> prependFirst indent styledMsg) where indent = if null quote then "" else " " -viewSentBroadcast :: MsgContent -> Int -> ZonedTime -> [StyledString] -viewSentBroadcast mc n ts = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts <> " ") (ttyMsgContent mc) +ttyMsgTime :: CurrentTime -> ZonedTime -> StyledString +ttyMsgTime ts t = + let localTime = zonedTimeToLocalTime t + tz = zonedTimeZone t + fmt = + if (localDay localTime < localDay (zonedTimeToLocalTime $ utcToZonedTime tz ts)) + && (timeOfDayToTime (localTimeOfDay localTime) > (6 * 60 * 60 :: DiffTime)) + then "%m-%d" -- if message is from yesterday or before and 6 hours has passed since midnight + else "%H:%M" + in styleTime $ formatTime defaultTimeLocale fmt localTime -viewSentFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString] -viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} = case filePath of - Just fPath -> sentWithTime_ $ ttySentFile fPath +viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta d -> [StyledString] +viewSentMessage to quote mc ts = sentWithTime_ ts (prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc)) + where + indent = if null quote then "" else " " + +viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> ZonedTime -> [StyledString] +viewSentBroadcast mc n ts t = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts t <> " ") (ttyMsgContent mc) + +viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta d -> [StyledString] +viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePath of + Just fPath -> sentWithTime_ ts $ ttySentFile fPath _ -> const [] where ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending @@ -839,12 +842,9 @@ viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} = case filePath CIFSSndTransfer -> [] _ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"] -sentWithTime_ :: [StyledString] -> CIMeta d -> [StyledString] -sentWithTime_ styledMsg CIMeta {localItemTs} = - prependFirst (ttyMsgTime localItemTs <> " ") styledMsg - -ttyMsgTime :: ZonedTime -> StyledString -ttyMsgTime = styleTime . formatTime defaultTimeLocale "%H:%M" +sentWithTime_ :: CurrentTime -> [StyledString] -> CIMeta d -> [StyledString] +sentWithTime_ ts styledMsg CIMeta {localItemTs} = + prependFirst (ttyMsgTime ts localItemTs <> " ") styledMsg ttyMsgContent :: MsgContent -> [StyledString] ttyMsgContent = msgPlain . msgContentText @@ -873,8 +873,8 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} = sndFile :: SndFileTransfer -> StyledString sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName -viewReceivedFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString] -viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file) +viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta d -> [StyledString] +viewReceivedFileInvitation from file ts meta = receivedWithTime_ ts from [] meta (receivedFileInvitation_ file) receivedFileInvitation_ :: CIFile d -> [StyledString] receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} =