mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: voice msg content type (#1368)
This commit is contained in:
@@ -387,6 +387,7 @@ processChatCommand = \case
|
||||
MCFile _ -> False
|
||||
MCLink {} -> True
|
||||
MCImage {} -> True
|
||||
MCVoice {} -> False
|
||||
MCUnknown {} -> True
|
||||
qText = msgContentText qmc
|
||||
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
|
||||
|
||||
@@ -881,14 +881,9 @@ ciCallInfoText status duration = case status of
|
||||
CISCallRejected -> "rejected"
|
||||
CISCallAccepted -> "accepted"
|
||||
CISCallNegotiated -> "connecting..."
|
||||
CISCallProgress -> "in progress " <> d
|
||||
CISCallEnded -> "ended " <> d
|
||||
CISCallProgress -> "in progress " <> durationText duration
|
||||
CISCallEnded -> "ended " <> durationText duration
|
||||
CISCallError -> "error"
|
||||
where
|
||||
d = let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
|
||||
with0 n
|
||||
| n < 9 = '0' : show n
|
||||
| otherwise = show n
|
||||
|
||||
data SChatType (c :: ChatType) where
|
||||
SCTDirect :: SChatType 'CTDirect
|
||||
|
||||
@@ -29,6 +29,7 @@ import Data.ByteString.Internal (c2w, w2c)
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Type.Equality
|
||||
@@ -263,7 +264,7 @@ cmToQuotedMsg = \case
|
||||
ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
|
||||
_ -> Nothing
|
||||
|
||||
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text
|
||||
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVoice_ | MCFile_ | MCUnknown_ Text
|
||||
|
||||
instance StrEncoding MsgContentTag where
|
||||
strEncode = \case
|
||||
@@ -271,11 +272,13 @@ instance StrEncoding MsgContentTag where
|
||||
MCLink_ -> "link"
|
||||
MCImage_ -> "image"
|
||||
MCFile_ -> "file"
|
||||
MCVoice_ -> "voice"
|
||||
MCUnknown_ t -> encodeUtf8 t
|
||||
strDecode = \case
|
||||
"text" -> Right MCText_
|
||||
"link" -> Right MCLink_
|
||||
"image" -> Right MCImage_
|
||||
"voice" -> Right MCVoice_
|
||||
"file" -> Right MCFile_
|
||||
t -> Right . MCUnknown_ $ safeDecodeUtf8 t
|
||||
strP = strDecode <$?> A.takeTill (== ' ')
|
||||
@@ -313,6 +316,7 @@ data MsgContent
|
||||
= MCText Text
|
||||
| MCLink {text :: Text, preview :: LinkPreview}
|
||||
| MCImage {text :: Text, image :: ImageData}
|
||||
| MCVoice {text :: Text, duration :: Int}
|
||||
| MCFile Text
|
||||
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
|
||||
deriving (Eq, Show)
|
||||
@@ -322,14 +326,27 @@ msgContentText = \case
|
||||
MCText t -> t
|
||||
MCLink {text} -> text
|
||||
MCImage {text} -> text
|
||||
MCVoice {text, duration} ->
|
||||
if T.null text then msg else msg <> "; " <> text
|
||||
where
|
||||
msg = "voice message " <> durationText duration <> "s"
|
||||
MCFile t -> t
|
||||
MCUnknown {text} -> text
|
||||
|
||||
durationText :: Int -> Text
|
||||
durationText duration =
|
||||
let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
|
||||
where
|
||||
with0 n
|
||||
| n < 9 = '0' : show n
|
||||
| otherwise = show n
|
||||
|
||||
msgContentTag :: MsgContent -> MsgContentTag
|
||||
msgContentTag = \case
|
||||
MCText _ -> MCText_
|
||||
MCLink {} -> MCLink_
|
||||
MCImage {} -> MCImage_
|
||||
MCVoice {} -> MCVoice_
|
||||
MCFile {} -> MCFile_
|
||||
MCUnknown {tag} -> MCUnknown_ tag
|
||||
|
||||
@@ -356,6 +373,10 @@ instance FromJSON MsgContent where
|
||||
text <- v .: "text"
|
||||
image <- v .: "image"
|
||||
pure MCImage {image, text}
|
||||
MCVoice_ -> do
|
||||
text <- v .: "text"
|
||||
duration <- v .: "duration"
|
||||
pure MCVoice {text, duration}
|
||||
MCFile_ -> MCFile <$> v .: "text"
|
||||
MCUnknown_ tag -> do
|
||||
text <- fromMaybe unknownMsgType <$> v .:? "text"
|
||||
@@ -382,12 +403,14 @@ instance ToJSON MsgContent where
|
||||
MCText t -> J.object ["type" .= MCText_, "text" .= t]
|
||||
MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview]
|
||||
MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image]
|
||||
MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration]
|
||||
MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
|
||||
toEncoding = \case
|
||||
MCUnknown {json} -> JE.value $ J.Object json
|
||||
MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
|
||||
MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview
|
||||
MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image
|
||||
MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration
|
||||
MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t
|
||||
|
||||
instance ToField MsgContent where
|
||||
|
||||
Reference in New Issue
Block a user